aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-06-23 11:02:14 +0100
committerGitHub <noreply@github.com>2021-06-23 11:02:14 +0100
commitd693d685d033c0da9c24686d61fdf6ede2caa7e4 (patch)
treee8b8640efe12ac729851f2992e6243658b5922de
parent0372313a91263789c843623fca0aab9a4e340e19 (diff)
parent63288a62ceeb20c53ba656b89c0f7c709ad9dbaa (diff)
downloadfpm-d693d685d033c0da9c24686d61fdf6ede2caa7e4.tar.gz
fpm-d693d685d033c0da9c24686d61fdf6ede2caa7e4.zip
Merge pull request #500 from awvwgk/version-file
Allow reading version number from file
-rwxr-xr-xci/run_tests.sh5
-rw-r--r--example_packages/README.md1
-rw-r--r--example_packages/version_file/VERSION1
-rw-r--r--example_packages/version_file/app/main.f9013
-rw-r--r--example_packages/version_file/fpm.toml2
-rw-r--r--manifest-reference.md8
-rw-r--r--src/fpm/cmd/new.f902
-rw-r--r--src/fpm/manifest.f902
-rw-r--r--src/fpm/manifest/package.f9029
-rw-r--r--src/fpm_filesystem.f901
-rw-r--r--test/fpm_test/test_manifest.f9014
11 files changed, 66 insertions, 12 deletions
diff --git a/ci/run_tests.sh b/ci/run_tests.sh
index 9db88e8..ff477e7 100755
--- a/ci/run_tests.sh
+++ b/ci/run_tests.sh
@@ -62,6 +62,11 @@ test ! -x ./build/gfortran_*/app/unused
test ! -x ./build/gfortran_*/test/unused_test
popd
+pushd version_file
+"$fpm" build
+"$fpm" run
+popd
+
pushd with_c
"$fpm" build
"$fpm" run --target with_c
diff --git a/example_packages/README.md b/example_packages/README.md
index b556dcb..139f8dc 100644
--- a/example_packages/README.md
+++ b/example_packages/README.md
@@ -22,5 +22,6 @@ the features demonstrated in each package and which versions of fpm are supporte
| submodules | Lib-only; submodules (3 levels) | N | Y |
| link_external | Link external library | N | Y |
| link_executable | Link external library to a single executable | N | Y |
+| version_file | Read version number from a file in the project root | N | Y |
| with_c | Compile with `c` source files | N | Y |
| with_makefile | External build command (makefile) | Y | N |
diff --git a/example_packages/version_file/VERSION b/example_packages/version_file/VERSION
new file mode 100644
index 0000000..ae84a9c
--- /dev/null
+++ b/example_packages/version_file/VERSION
@@ -0,0 +1 @@
+5.42.1
diff --git a/example_packages/version_file/app/main.f90 b/example_packages/version_file/app/main.f90
new file mode 100644
index 0000000..fcf8d64
--- /dev/null
+++ b/example_packages/version_file/app/main.f90
@@ -0,0 +1,13 @@
+program stub
+ implicit none
+ logical :: exists
+ integer :: unit
+ character(len=100) :: line
+ inquire(file="VERSION", exist=exists)
+ if (.not.exists) error stop "File VERSION does not exist."
+ open(file="VERSION", newunit=unit)
+ read(unit, '(a)') line
+ close(unit)
+
+ print '(*(a))', "File VERSION contains '", trim(line), "'"
+end program stub
diff --git a/example_packages/version_file/fpm.toml b/example_packages/version_file/fpm.toml
new file mode 100644
index 0000000..4dd64fd
--- /dev/null
+++ b/example_packages/version_file/fpm.toml
@@ -0,0 +1,2 @@
+name = "version_file"
+version = "VERSION"
diff --git a/manifest-reference.md b/manifest-reference.md
index cd79b0b..0a68c6a 100644
--- a/manifest-reference.md
+++ b/manifest-reference.md
@@ -78,6 +78,14 @@ A standardized way to manage and specify versions is the [Semantic Versioning] s
version = "1.0.0"
```
+The version entry can also contain a filename relative to the project root, which contains the version number of the project
+
+*Example:*
+
+```toml
+version = "VERSION"
+```
+
[Semantic Versioning]: https://semver.org
diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90
index 773d7a7..1e92678 100644
--- a/src/fpm/cmd/new.f90
+++ b/src/fpm/cmd/new.f90
@@ -605,7 +605,7 @@ character(len=*),intent(in) :: filename
call set_value(table, "copyright", 'Copyright '//date(1:4)//', Jane Doe')
! continue building of manifest
! ...
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
if (allocated(error)) stop 3
if(settings%verbose)then
call table%accept(ser)
diff --git a/src/fpm/manifest.f90 b/src/fpm/manifest.f90
index 4170b91..8c39aa6 100644
--- a/src/fpm/manifest.f90
+++ b/src/fpm/manifest.f90
@@ -113,7 +113,7 @@ contains
return
end if
- call new_package(package, table, error)
+ call new_package(package, table, dirname(file), error)
if (allocated(error)) return
if (present(apply_defaults)) then
diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90
index bbaa51d..0430761 100644
--- a/src/fpm/manifest/package.f90
+++ b/src/fpm/manifest/package.f90
@@ -38,6 +38,7 @@ module fpm_manifest_package
use fpm_manifest_library, only : library_config_t, new_library
use fpm_manifest_install, only: install_config_t, new_install_config
use fpm_manifest_test, only : test_config_t, new_test
+ use fpm_filesystem, only : exists, getline, join_path
use fpm_error, only : error_t, fatal_error, syntax_error
use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, &
& len
@@ -99,7 +100,7 @@ contains
!> Construct a new package configuration from a TOML data structure
- subroutine new_package(self, table, error)
+ subroutine new_package(self, table, root, error)
!> Instance of the package configuration
type(package_config_t), intent(out) :: self
@@ -107,6 +108,9 @@ contains
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
+ !> Root directory of the manifest
+ character(len=*), intent(in), optional :: root
+
!> Error handling
type(error_t), allocatable, intent(out) :: error
@@ -116,8 +120,8 @@ contains
achar(8) // achar(9) // achar(10) // achar(12) // achar(13)
type(toml_table), pointer :: child, node
type(toml_array), pointer :: children
- character(len=:), allocatable :: version
- integer :: ii, nn, stat
+ character(len=:), allocatable :: version, version_file
+ integer :: ii, nn, stat, io
call check(table, error)
if (allocated(error)) return
@@ -157,6 +161,25 @@ contains
call get_value(table, "version", version, "0")
call new_version(self%version, version, error)
+ if (allocated(error) .and. present(root)) then
+ version_file = join_path(root, version)
+ if (exists(version_file)) then
+ deallocate(error)
+ open(file=version_file, newunit=io, iostat=stat)
+ if (stat == 0) then
+ call getline(io, version, iostat=stat)
+ end if
+ if (stat == 0) then
+ close(io, iostat=stat)
+ end if
+ if (stat == 0) then
+ call new_version(self%version, version, error)
+ else
+ call fatal_error(error, "Reading version number from file '" &
+ & //version_file//"' failed")
+ end if
+ end if
+ end if
if (allocated(error)) return
call get_value(table, "dependencies", child, requested=.false.)
diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90
index 486e989..e6226b4 100644
--- a/src/fpm_filesystem.f90
+++ b/src/fpm_filesystem.f90
@@ -184,6 +184,7 @@ function dirname(path) result (dir)
character(:), allocatable :: dir
dir = path(1:scan(path,'/\',back=.true.))
+ if (len_trim(dir) == 0) dir = "."
end function dirname
diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90
index 94e5e07..69c86fd 100644
--- a/test/fpm_test/test_manifest.f90
+++ b/test/fpm_test/test_manifest.f90
@@ -658,7 +658,7 @@ contains
call add_table(children, child, stat)
call set_value(child, 'name', '"tester"', stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_simple
@@ -676,7 +676,7 @@ contains
call new_table(table)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_empty
@@ -697,7 +697,7 @@ contains
call new_table(table)
call add_array(table, "name", child, stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_typeerror
@@ -720,7 +720,7 @@ contains
call add_table(table, "dev-dependencies", child, stat)
call add_table(table, "dependencies", child, stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_noname
@@ -743,7 +743,7 @@ contains
call add_array(table, 'executable', children, stat)
call add_array(children, children2, stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_wrongexe
@@ -766,7 +766,7 @@ contains
call add_array(table, 'test', children, stat)
call add_array(children, children2, stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_wrongtest
@@ -793,7 +793,7 @@ contains
call add_table(children, child, stat)
call set_value(child, 'name', '"prog"', stat)
- call new_package(package, table, error)
+ call new_package(package, table, error=error)
end subroutine test_package_duplicate