From a82a07155261116fc15947d1fbf7d3eaa85af103 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 09:36:51 +0100 Subject: Add: path canonicalizer for path comparison Returns canonical path form with redundant artifacts. --- fpm/src/fpm_filesystem.f90 | 91 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 90 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 91baba1..0ef844f 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -5,7 +5,7 @@ module fpm_filesystem use fpm_strings, only: f_string, string_t, split implicit none private - public :: basename, dirname, is_dir, join_path, number_of_rows, read_lines, list_files,& + public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files,& mkdir, exists, get_temp_filename, windows_path integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -40,6 +40,76 @@ function basename(path,suffix) result (base) end function basename +function canon_path(path) result(canon) + ! Canonicalize path for comparison + ! Handles path string redundancies + ! Does not test existence of path + ! + ! To be replaced by realpath/_fullname in stdlib_os + ! + character(*), intent(in) :: path + character(:), allocatable :: canon + + integer :: i, j + integer :: iback + character(len(path)) :: nixpath + character(len(path)) :: temp + + nixpath = unix_path(path) + + j = 1 + do i=1,len(nixpath) + + ! Skip back to last directory for '/../' + if (i > 4) then + + if (nixpath(i-3:i) == '/../') then + + iback = scan(nixpath(1:i-4),'/',back=.true.) + if (iback > 0) then + j = iback + 1 + cycle + end if + + end if + + end if + + if (i > 1 .and. j > 1) then + + ! Ignore current directory reference + if (nixpath(i-1:i) == './') then + + j = j - 1 + cycle + + end if + + ! Ignore repeated separators + if (nixpath(i-1:i) == '//') then + + cycle + + end if + + ! Do NOT include trailing slash + if (i == len(nixpath) .and. nixpath(i:i) == '/') then + cycle + end if + + end if + + + temp(j:j) = nixpath(i:i) + j = j + 1 + + end do + + canon = temp(1:j-1) + +end function canon_path + + function dirname(path) result (dir) ! Extract dirname from path ! @@ -287,4 +357,23 @@ function windows_path(path) result(winpath) end function windows_path + +function unix_path(path) result(nixpath) + ! Replace file system separators for unix + ! + character(*), intent(in) :: path + character(:), allocatable :: nixpath + + integer :: idx + + nixpath = path + + idx = index(nixpath,'\') + do while(idx > 0) + nixpath(idx:idx) = '/' + idx = index(nixpath,'\') + end do + +end function unix_path + end module fpm_filesystem -- cgit v1.2.3 From c058c12e0bba167f59a3270b80e7617b002d7b36 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 09:38:36 +0100 Subject: Fix: matching of program sources with fpm executables Add test on path of program source with source-dir of [[executable]] entry. For case of two executables with same name in different directories, both with overrides in fpm.toml --- fpm/src/fpm_sources.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 266e52a..e8b2f88 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_filesystem, only: basename, dirname, read_lines, list_files +use fpm_filesystem, only: basename, canon_path, dirname, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none @@ -137,7 +137,9 @@ subroutine add_executable_sources(sources,executables,scope,error) do j=1,size(executables) if (basename(sources(i)%file_name,suffix=.true.) == & - executables(j)%main) then + if (basename(sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& + canon_path(dirname(sources(i)%file_name)) == & + canon_path(executables(j)%source_dir) ) then sources(i)%exe_name = executables(j)%name exit -- cgit v1.2.3 From f10b174e6676031af9f32f704d9b317525fa5602 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 10:05:15 +0100 Subject: Add: source-level flag to enable/disable auto-discovery --- fpm/src/fpm.f90 | 4 ++-- fpm/src/fpm_sources.f90 | 34 ++++++++++++++++++++++++++-------- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 7c99b13..a879341 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -77,7 +77,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%executable)) then call add_executable_sources(model%sources, package%executable, & - FPM_SCOPE_APP, error=error) + FPM_SCOPE_APP, auto_discover=.true., error=error) if (allocated(error)) then return @@ -86,7 +86,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%test)) then call add_executable_sources(model%sources, package%test, & - FPM_SCOPE_TEST, error=error) + FPM_SCOPE_TEST, auto_discover=.true., error=error) if (allocated(error)) then return diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index e8b2f88..f798276 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -109,23 +109,26 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) end subroutine add_sources_from_dir -subroutine add_executable_sources(sources,executables,scope,error) +subroutine add_executable_sources(sources,executables,scope,auto_discover,error) ! Include sources from any directories specified ! in [[executable]] entries and apply any customisations ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) class(executable_t), intent(in) :: executables(:) integer, intent(in) :: scope + logical, intent(in) :: auto_discover type(error_t), allocatable, intent(out) :: error integer :: i, j type(string_t), allocatable :: exe_dirs(:) + logical, allocatable :: include_source(:) + type(srcfile_t), allocatable :: dir_sources(:) call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) - call add_sources_from_dir(sources,exe_dirs(i)%s, & + call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & scope, with_executables=.true.,error=error) if (allocated(error)) then @@ -133,21 +136,36 @@ subroutine add_executable_sources(sources,executables,scope,error) end if end do - do i = 1, size(sources) + allocate(include_source(size(dir_sources))) + + do i = 1, size(dir_sources) + ! Include source by default if not a program or if auto_discover is enabled + include_source(i) = (dir_sources(i)%unit_type /= FPM_UNIT_PROGRAM) .or. & + auto_discover + + ! Always include sources specified in fpm.toml do j=1,size(executables) - if (basename(sources(i)%file_name,suffix=.true.) == & - if (basename(sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& - canon_path(dirname(sources(i)%file_name)) == & + + if (basename(dir_sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& + canon_path(dirname(dir_sources(i)%file_name)) == & canon_path(executables(j)%source_dir) ) then - - sources(i)%exe_name = executables(j)%name + + include_source(i) = .true. + dir_sources(i)%exe_name = executables(j)%name exit + end if end do end do + if (.not.allocated(sources)) then + sources = pack(dir_sources,include_source) + else + sources = [sources, pack(dir_sources,include_source)] + end if + end subroutine add_executable_sources -- cgit v1.2.3 From 99da449d12232615ef1f57ea37f2c063755c2bee Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 12:35:33 +0100 Subject: Add: [build] table to manifest with flags for auto-discovery --- fpm/src/fpm.f90 | 24 ++++-- fpm/src/fpm/manifest.f90 | 14 ++++ fpm/src/fpm/manifest/build_config.f90 | 140 ++++++++++++++++++++++++++++++++++ fpm/src/fpm/manifest/package.f90 | 18 ++++- 4 files changed, 188 insertions(+), 8 deletions(-) create mode 100644 fpm/src/fpm/manifest/build_config.f90 diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index a879341..9db2126 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -13,7 +13,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & use fpm_sources, only: add_executable_sources, add_sources_from_dir, & resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & - default_library, package_t + default_library, default_build_config, package_t use fpm_error, only : error_t use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -57,7 +57,7 @@ subroutine build_model(model, settings, package, error) model%link_flags = '' ! Add sources from executable directories - if (is_dir('app')) then + if (is_dir('app') .and. package%build_config%auto_executables) then call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, & with_executables=.true., error=error) @@ -66,7 +66,7 @@ subroutine build_model(model, settings, package, error) end if end if - if (is_dir('test')) then + if (is_dir('test') .and. package%build_config%auto_tests) then call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, & with_executables=.true., error=error) @@ -76,8 +76,9 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable, & - FPM_SCOPE_APP, auto_discover=.true., error=error) + call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, & + auto_discover=package%build_config%auto_executables, & + error=error) if (allocated(error)) then return @@ -85,8 +86,9 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test, & - FPM_SCOPE_TEST, auto_discover=.true., error=error) + call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, & + auto_discover=package%build_config%auto_tests, & + error=error) if (allocated(error)) then return @@ -119,6 +121,14 @@ if (allocated(error)) then error stop 1 end if +call package%info(stdout,10) + +! Populate default build configuration if not included +if (.not.allocated(package%build_config)) then + allocate(package%build_config) + call default_build_config(package%build_config) +end if + ! Populate library in case we find the default src directory if (.not.allocated(package%library) .and. exists("src")) then allocate(package%library) diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90 index af4e0fa..9b93c2c 100644 --- a/fpm/src/fpm/manifest.f90 +++ b/fpm/src/fpm/manifest.f90 @@ -7,6 +7,7 @@ ! Additionally, the required data types for users of this module are reexported ! to hide the actual implementation details. module fpm_manifest + use fpm_manifest_build_config, only: build_config_t use fpm_manifest_executable, only : executable_t use fpm_manifest_library, only : library_t use fpm_manifest_package, only : package_t, new_package @@ -16,12 +17,25 @@ module fpm_manifest private public :: get_package_data, default_executable, default_library + public :: default_build_config public :: package_t contains + !> Populate build configuration with defaults + subroutine default_build_config(self) + + !> Instance of the build configuration data + type(build_config_t), intent(out) :: self + + self%auto_executables = .true. + self%auto_tests = .true. + + end subroutine default_build_config + + !> Populate library in case we find the default src directory subroutine default_library(self) diff --git a/fpm/src/fpm/manifest/build_config.f90 b/fpm/src/fpm/manifest/build_config.f90 new file mode 100644 index 0000000..069c3e0 --- /dev/null +++ b/fpm/src/fpm/manifest/build_config.f90 @@ -0,0 +1,140 @@ +!> Implementation of the build configuration data. +! +! A build table can currently have the following fields +! +! ```toml +! [build] +! auto-executables = +! auto-tests = +! ``` +module fpm_manifest_build_config + use fpm_error, only : error_t, syntax_error, fatal_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: build_config_t, new_build_config + + + !> Configuration data for build + type :: build_config_t + + !> Automatic discovery of executables + logical :: auto_executables + + !> Automatic discovery of tests + logical :: auto_tests + + contains + + !> Print information on this instance + procedure :: info + + end type build_config_t + + +contains + + + !> Construct a new build configuration from a TOML data structure + subroutine new_build_config(self, table, error) + + !> Instance of the build configuration + type(build_config_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Status + integer :: stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "auto-executables", self%auto_executables, .true., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'auto-executables' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "auto-tests", self%auto_tests, .true., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'auto-tests' in fpm.toml, expecting logical") + return + end if + + end subroutine new_build_config + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (size(list) < 1) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + + case("auto-executables", "auto-tests") + continue + + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [build]") + exit + + end select + end do + + end subroutine check + + + !> Write information on build configuration instance + subroutine info(self, unit, verbosity) + + !> Instance of the build configuration + class(build_config_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Build configuration" + ! if (allocated(self%auto_executables)) then + write(unit, fmt) " - auto-discovery (apps) ", merge("enabled ", "disabled", self%auto_executables) + ! end if + ! if (allocated(self%auto_tests)) then + write(unit, fmt) " - auto-discovery (tests) ", merge("enabled ", "disabled", self%auto_tests) + ! end if + + end subroutine info + +end module fpm_manifest_build_config diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index dff81e5..4e83411 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -28,6 +28,7 @@ ! [[test]] ! ``` module fpm_manifest_package + use fpm_manifest_build_config, only: build_config_t, new_build_config use fpm_manifest_dependency, only : dependency_t, new_dependencies use fpm_manifest_executable, only : executable_t, new_executable use fpm_manifest_library, only : library_t, new_library @@ -47,6 +48,9 @@ module fpm_manifest_package !> Name of the package character(len=:), allocatable :: name + !> Build configuration data + type(build_config_t), allocatable :: build_config + !> Library meta data type(library_t), allocatable :: library @@ -98,6 +102,13 @@ contains return end if + call get_value(table, "build", child, requested=.false.) + if (associated(child)) then + allocate(self%build_config) + call new_build_config(self%build_config, child, error) + if (allocated(error)) return + end if + call get_value(table, "dependencies", child, requested=.false.) if (associated(child)) then call new_dependencies(self%dependency, child, error) @@ -184,7 +195,7 @@ contains name_present = .true. case("version", "license", "author", "maintainer", "copyright", & - & "description", "keywords", "categories", "homepage", & + & "description", "keywords", "categories", "homepage", "build", & & "dependencies", "dev-dependencies", "test", "executable", & & "library") continue @@ -229,6 +240,11 @@ contains write(unit, fmt) "- name", self%name end if + if (allocated(self%build_config)) then + write(unit, fmt) "- build configuration", "" + call self%build_config%info(unit, pr - 1) + end if + if (allocated(self%library)) then write(unit, fmt) "- target", "archive" call self%library%info(unit, pr - 1) -- cgit v1.2.3 From 1d0c99e6ee605f6a769fdc6c98a6a360c0e6f89a Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 12:35:49 +0100 Subject: Add: tests for new [build] table in manifest --- fpm/test/fpm_test/test_manifest.f90 | 147 +++++++++++++++++++++++++++++++++++- 1 file changed, 146 insertions(+), 1 deletion(-) diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index d2dc891..4b428d1 100644 --- a/fpm/test/fpm_test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 @@ -1,5 +1,6 @@ !> Define tests for the `fpm_manifest` modules module test_manifest + use fpm_filesystem, only: get_temp_filename use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_manifest @@ -17,10 +18,11 @@ contains !> Collection of tests type(unittest_t), allocatable, intent(out) :: testsuite(:) - + testsuite = [ & & new_unittest("valid-manifest", test_valid_manifest), & & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & + & new_unittest("default-build-configuration", test_default_build_config), & & new_unittest("default-library", test_default_library), & & new_unittest("default-executable", test_default_executable), & & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & @@ -35,6 +37,9 @@ contains & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), & & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), & & new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), & + & new_unittest("build-config-valid", test_build_config_valid), & + & new_unittest("build-config-empty", test_build_config_empty), & + & new_unittest("build-config-invalid-values", test_build_config_invalid_values, should_fail=.true.), & & new_unittest("library-empty", test_library_empty), & & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & & new_unittest("package-simple", test_package_simple), & @@ -65,6 +70,9 @@ contains open(file=manifest, newunit=unit) write(unit, '(a)') & & 'name = "example"', & + & '[build]', & + & 'auto-executables = false', & + & 'auto-tests = false', & & '[dependencies.fpm]', & & 'git = "https://github.com/fortran-lang/fpm"', & & '[[executable]]', & @@ -94,6 +102,11 @@ contains return end if + if (.not.allocated(package%build_config)) then + call test_failed(error, "build is not present in package data") + return + end if + if (.not.allocated(package%library)) then call test_failed(error, "library is not present in package data") return @@ -152,6 +165,31 @@ contains end subroutine test_invalid_manifest + !> Create a default build configuration + subroutine test_default_build_config(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + + allocate(package%build_config) + call default_build_config(package%build_config) + + if (.not. package%build_config%auto_executables) then + call test_failed(error,'Incorrect value for auto_executables in default build configuration, expecting .true.') + return + end if + + if (.not. package%build_config%auto_tests) then + call test_failed(error,'Incorrect value for auto_tests in default build configuration, expecting .true.') + return + end if + + + end subroutine test_default_build_config + + !> Create a default library subroutine test_default_library(error) @@ -446,6 +484,113 @@ contains end subroutine test_executable_wrongkey + !> Try to read values from the [build] table + subroutine test_build_config_valid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & 'auto-executables = false', & + & 'auto-tests = false' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + if (.not.allocated(package%build_config)) then + call test_failed(error, "build is not present in package data") + return + end if + + if (package%build_config%auto_executables) then + call test_failed(error, "Wong value of 'auto-executables' read, expecting .false.") + return + end if + + if (package%build_config%auto_tests) then + call test_failed(error, "Wong value of 'auto-tests' read, expecting .false.") + return + end if + + end subroutine test_build_config_valid + + + !> Try to read values from an empty [build] table + subroutine test_build_config_empty(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & '[library]' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + if (.not.allocated(package%build_config)) then + call test_failed(error, "build is not present in package data") + return + end if + + if (.not.package%build_config%auto_executables) then + call test_failed(error, "Wong default value of 'auto-executables' read, expecting .true.") + return + end if + + if (.not.package%build_config%auto_tests) then + call test_failed(error, "Wong default value of 'auto-tests' read, expecting .true.") + return + end if + + end subroutine test_build_config_empty + + + !> Try to read values from a [build] table with invalid values + subroutine test_build_config_invalid_values(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & 'auto-executables = "false"' + close(unit) + + call get_package_data(package, temp_file, error) + + end subroutine test_build_config_invalid_values + + !> Libraries can be created from empty tables subroutine test_library_empty(error) use fpm_manifest_library -- cgit v1.2.3 From ad02416e06e1cb9373fa69c6f61492fd498c87d2 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 13:38:07 +0100 Subject: Add: test package with auto-discovery disabled Contains an app and a test that should be ignored by auto-discovery - this is checked in the CI scripts. --- ci/run_tests.bat | 17 +++++++++++++++++ ci/run_tests.sh | 7 +++++++ fpm/src/fpm.f90 | 2 -- test/example_packages/README.md | 1 + test/example_packages/auto_discovery_off/app/main.f90 | 6 ++++++ test/example_packages/auto_discovery_off/app/unused.f90 | 6 ++++++ test/example_packages/auto_discovery_off/fpm.toml | 12 ++++++++++++ .../auto_discovery_off/test/my_test.f90 | 6 ++++++ .../auto_discovery_off/test/unused_test.f90 | 7 +++++++ 9 files changed, 62 insertions(+), 2 deletions(-) create mode 100644 test/example_packages/auto_discovery_off/app/main.f90 create mode 100644 test/example_packages/auto_discovery_off/app/unused.f90 create mode 100644 test/example_packages/auto_discovery_off/fpm.toml create mode 100644 test/example_packages/auto_discovery_off/test/my_test.f90 create mode 100644 test/example_packages/auto_discovery_off/test/unused_test.f90 diff --git a/ci/run_tests.bat b/ci/run_tests.bat index ce79618..76e5349 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -62,6 +62,23 @@ if errorlevel 1 exit 1 .\build\gfortran_debug\test\farewell_test +cd ..\auto_discovery_off +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\auto_discovery_off +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\my_test +if errorlevel 1 exit 1 + +if exist .\build\gfortran_debug\app\unused exit /B 1 + +if exist .\build\gfortran_debug\test\unused_test exit /B 1 + + cd ..\with_c if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ee46cac..adff2b3 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -26,6 +26,13 @@ cd ../hello_complex_2 ./build/gfortran_debug/test/greet_test ./build/gfortran_debug/test/farewell_test +cd ../auto_discovery_off +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/auto_discovery_off +./build/gfortran_debug/test/my_test +test ! -x ./build/gfortran_debug/app/unused +test ! -x ./build/gfortran_debug/test/unused_test + cd ../with_c ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/with_c diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 9db2126..fc22324 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -121,8 +121,6 @@ if (allocated(error)) then error stop 1 end if -call package%info(stdout,10) - ! Populate default build configuration if not included if (.not.allocated(package%build_config)) then allocate(package%build_config) diff --git a/test/example_packages/README.md b/test/example_packages/README.md index fd02f0d..79fadb1 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -6,6 +6,7 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| +| auto_discovery_off | Default layout with auto-discovery disabled | N | Y | | circular_example | Local path dependency; circular dependency | Y | N | | circular_test | Local path dependency; circular dependency | Y | N | | hello_complex | Non-standard directory layout; multiple tests and executables | Y | Y | diff --git a/test/example_packages/auto_discovery_off/app/main.f90 b/test/example_packages/auto_discovery_off/app/main.f90 new file mode 100644 index 0000000..8902dc6 --- /dev/null +++ b/test/example_packages/auto_discovery_off/app/main.f90 @@ -0,0 +1,6 @@ +program main +implicit none + +print *, "This program should run." + +end program main diff --git a/test/example_packages/auto_discovery_off/app/unused.f90 b/test/example_packages/auto_discovery_off/app/unused.f90 new file mode 100644 index 0000000..57d8153 --- /dev/null +++ b/test/example_packages/auto_discovery_off/app/unused.f90 @@ -0,0 +1,6 @@ +program unused +implicit none + +print *, "This program should NOT run." + +end program unused diff --git a/test/example_packages/auto_discovery_off/fpm.toml b/test/example_packages/auto_discovery_off/fpm.toml new file mode 100644 index 0000000..9a852df --- /dev/null +++ b/test/example_packages/auto_discovery_off/fpm.toml @@ -0,0 +1,12 @@ +name = "auto_discovery_off" + +[build] +auto-executables = false +auto-tests = false + + +[[test]] +name = "my_test" +source-dir="test" +main="my_test.f90" + diff --git a/test/example_packages/auto_discovery_off/test/my_test.f90 b/test/example_packages/auto_discovery_off/test/my_test.f90 new file mode 100644 index 0000000..fd59f9f --- /dev/null +++ b/test/example_packages/auto_discovery_off/test/my_test.f90 @@ -0,0 +1,6 @@ +program my_test +implicit none + +print *, "Test passed! That was easy!" + +end program my_test diff --git a/test/example_packages/auto_discovery_off/test/unused_test.f90 b/test/example_packages/auto_discovery_off/test/unused_test.f90 new file mode 100644 index 0000000..5c42611 --- /dev/null +++ b/test/example_packages/auto_discovery_off/test/unused_test.f90 @@ -0,0 +1,7 @@ +program unused_test +implicit none + +print *, "This program should NOT run." + +end program unused_test + -- cgit v1.2.3 From fc8cab51bc025e2f58c15510f6b5021da6370ebc Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 29 Sep 2020 13:52:07 +0100 Subject: Let toml-f make [build] table while querying the data structure No need for separate default initializer for build table. Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- fpm/src/fpm.f90 | 8 +------- fpm/src/fpm/manifest.f90 | 13 ------------- fpm/src/fpm/manifest/package.f90 | 13 +++++++------ fpm/test/fpm_test/test_manifest.f90 | 26 -------------------------- 4 files changed, 8 insertions(+), 52 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index fc22324..bd93b2a 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -13,7 +13,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & use fpm_sources, only: add_executable_sources, add_sources_from_dir, & resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & - default_library, default_build_config, package_t + default_library, package_t use fpm_error, only : error_t use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -121,12 +121,6 @@ if (allocated(error)) then error stop 1 end if -! Populate default build configuration if not included -if (.not.allocated(package%build_config)) then - allocate(package%build_config) - call default_build_config(package%build_config) -end if - ! Populate library in case we find the default src directory if (.not.allocated(package%library) .and. exists("src")) then allocate(package%library) diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90 index 9b93c2c..0098890 100644 --- a/fpm/src/fpm/manifest.f90 +++ b/fpm/src/fpm/manifest.f90 @@ -17,25 +17,12 @@ module fpm_manifest private public :: get_package_data, default_executable, default_library - public :: default_build_config public :: package_t contains - !> Populate build configuration with defaults - subroutine default_build_config(self) - - !> Instance of the build configuration data - type(build_config_t), intent(out) :: self - - self%auto_executables = .true. - self%auto_tests = .true. - - end subroutine default_build_config - - !> Populate library in case we find the default src directory subroutine default_library(self) diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 4e83411..fcc4e3c 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -102,12 +102,14 @@ contains return end if - call get_value(table, "build", child, requested=.false.) - if (associated(child)) then - allocate(self%build_config) - call new_build_config(self%build_config, child, error) - if (allocated(error)) return + call get_value(table, "build", child, requested=.true., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Type mismatch for build entry, must be a table") + return end if + allocate(self%build_config) + call new_build_config(self%build_config, child, error) + if (allocated(error)) return call get_value(table, "dependencies", child, requested=.false.) if (associated(child)) then @@ -241,7 +243,6 @@ contains end if if (allocated(self%build_config)) then - write(unit, fmt) "- build configuration", "" call self%build_config%info(unit, pr - 1) end if diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index 4b428d1..e711ee4 100644 --- a/fpm/test/fpm_test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 @@ -22,7 +22,6 @@ contains testsuite = [ & & new_unittest("valid-manifest", test_valid_manifest), & & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & - & new_unittest("default-build-configuration", test_default_build_config), & & new_unittest("default-library", test_default_library), & & new_unittest("default-executable", test_default_executable), & & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & @@ -165,31 +164,6 @@ contains end subroutine test_invalid_manifest - !> Create a default build configuration - subroutine test_default_build_config(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - - allocate(package%build_config) - call default_build_config(package%build_config) - - if (.not. package%build_config%auto_executables) then - call test_failed(error,'Incorrect value for auto_executables in default build configuration, expecting .true.') - return - end if - - if (.not. package%build_config%auto_tests) then - call test_failed(error,'Incorrect value for auto_tests in default build configuration, expecting .true.') - return - end if - - - end subroutine test_default_build_config - - !> Create a default library subroutine test_default_library(error) -- cgit v1.2.3 From d09aa6a511935e1382c5a85d759ecd40cf37da12 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 29 Sep 2020 15:36:25 +0100 Subject: Update: package%build_config not allocatable --- fpm/src/fpm/manifest/package.f90 | 7 ++----- fpm/test/fpm_test/test_manifest.f90 | 15 --------------- 2 files changed, 2 insertions(+), 20 deletions(-) diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index fcc4e3c..946972e 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -49,7 +49,7 @@ module fpm_manifest_package character(len=:), allocatable :: name !> Build configuration data - type(build_config_t), allocatable :: build_config + type(build_config_t) :: build_config !> Library meta data type(library_t), allocatable :: library @@ -107,7 +107,6 @@ contains call fatal_error(error, "Type mismatch for build entry, must be a table") return end if - allocate(self%build_config) call new_build_config(self%build_config, child, error) if (allocated(error)) return @@ -242,9 +241,7 @@ contains write(unit, fmt) "- name", self%name end if - if (allocated(self%build_config)) then - call self%build_config%info(unit, pr - 1) - end if + call self%build_config%info(unit, pr - 1) if (allocated(self%library)) then write(unit, fmt) "- target", "archive" diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index e711ee4..575f255 100644 --- a/fpm/test/fpm_test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 @@ -101,11 +101,6 @@ contains return end if - if (.not.allocated(package%build_config)) then - call test_failed(error, "build is not present in package data") - return - end if - if (.not.allocated(package%library)) then call test_failed(error, "library is not present in package data") return @@ -482,11 +477,6 @@ contains if (allocated(error)) return - if (.not.allocated(package%build_config)) then - call test_failed(error, "build is not present in package data") - return - end if - if (package%build_config%auto_executables) then call test_failed(error, "Wong value of 'auto-executables' read, expecting .false.") return @@ -523,11 +513,6 @@ contains if (allocated(error)) return - if (.not.allocated(package%build_config)) then - call test_failed(error, "build is not present in package data") - return - end if - if (.not.package%build_config%auto_executables) then call test_failed(error, "Wong default value of 'auto-executables' read, expecting .true.") return -- cgit v1.2.3 From 0c35749e0d90b5de43a7a90eb47677695e5c81e2 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Tue, 29 Sep 2020 16:45:57 +0200 Subject: Implement version string comparison (#186) - allow semantic version matching --- fpm/src/fpm/manifest/package.f90 | 9 + fpm/src/fpm/versioning.f90 | 394 +++++++++++++++++++++++++++++++++ fpm/test/fpm_test/main.f90 | 4 +- fpm/test/fpm_test/test_versioning.f90 | 405 ++++++++++++++++++++++++++++++++++ 4 files changed, 811 insertions(+), 1 deletion(-) create mode 100644 fpm/src/fpm/versioning.f90 create mode 100644 fpm/test/fpm_test/test_versioning.f90 diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index dff81e5..039aa78 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -35,6 +35,7 @@ module fpm_manifest_package 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 + use fpm_versioning, only : version_t, new_version implicit none private @@ -47,6 +48,9 @@ module fpm_manifest_package !> Name of the package character(len=:), allocatable :: name + !> Package version + type(version_t) :: version + !> Library meta data type(library_t), allocatable :: library @@ -87,6 +91,7 @@ contains type(toml_table), pointer :: child, node type(toml_array), pointer :: children + character(len=:), allocatable :: version integer :: ii, nn, stat call check(table, error) @@ -98,6 +103,10 @@ contains return end if + call get_value(table, "version", version, "0") + call new_version(self%version, version, error) + if (allocated(error)) return + call get_value(table, "dependencies", child, requested=.false.) if (associated(child)) then call new_dependencies(self%dependency, child, error) diff --git a/fpm/src/fpm/versioning.f90 b/fpm/src/fpm/versioning.f90 new file mode 100644 index 0000000..145427e --- /dev/null +++ b/fpm/src/fpm/versioning.f90 @@ -0,0 +1,394 @@ +!> Implementation of versioning data for comparing packages +module fpm_versioning + use fpm_error, only : error_t, syntax_error + implicit none + private + + public :: version_t, new_version + + + type :: version_t + private + + !> Version numbers found + integer, allocatable :: num(:) + + contains + + generic :: operator(==) => equals + procedure, private :: equals + + generic :: operator(/=) => not_equals + procedure, private :: not_equals + + generic :: operator(>) => greater + procedure, private :: greater + + generic :: operator(<) => less + procedure, private :: less + + generic :: operator(>=) => greater_equals + procedure, private :: greater_equals + + generic :: operator(<=) => less_equals + procedure, private :: less_equals + + !> Compare a version against a version constraint (x.x.0 <= v < x.x.HUGE) + generic :: operator(.match.) => match + procedure, private :: match + + !> Create a printable string from a version data type + procedure :: to_string + + end type version_t + + + !> Arbitrary internal limit of the version parser + integer, parameter :: max_limit = 3 + + + interface new_version + module procedure :: new_version_from_string + module procedure :: new_version_from_int + end interface new_version + + +contains + + + !> Create a new version from a string + subroutine new_version_from_int(self, num) + + !> Instance of the versioning data + type(version_t), intent(out) :: self + + !> Subversion numbers to define version data + integer, intent(in) :: num(:) + + self%num = num + + end subroutine new_version_from_int + + + !> Create a new version from a string + subroutine new_version_from_string(self, string, error) + + !> Instance of the versioning data + type(version_t), intent(out) :: self + + !> String describing the version information + character(len=*), intent(in) :: string + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character :: tok + integer :: ii, istart, iend, stat, nn + integer :: num(max_limit) + logical :: is_number + + nn = 0 + iend = 0 + istart = 0 + is_number = .false. + + do while(iend < len(string)) + call next(string, istart, iend, is_number, error) + if (allocated(error)) exit + if (is_number) then + if (nn >= max_limit) then + call token_error(error, string, istart, iend, & + & "Too many subversions found") + exit + end if + nn = nn + 1 + read(string(istart:iend), *, iostat=stat) num(nn) + if (stat /= 0) then + call token_error(error, string, istart, iend, & + & "Failed to parse version number") + exit + end if + end if + end do + if (allocated(error)) return + if (.not.is_number) then + call token_error(error, string, istart, iend, & + & "Expected version number, but no characters are left") + return + end if + + call new_version(self, num(:nn)) + + end subroutine new_version_from_string + + + !> Tokenize a version string + subroutine next(string, istart, iend, is_number, error) + + !> String describing the version information + character(len=*), intent(in) :: string + + !> Start of last token, start of next token on exit + integer, intent(inout) :: istart + + !> End of last token on entry, end of next token on exit + integer, intent(inout) :: iend + + !> Token produced is a number + logical, intent(inout) :: is_number + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ii, nn + logical :: was_number + character :: tok, last + + was_number = is_number + nn = len(string) + + if (iend >= nn) then + istart = nn + iend = nn + return + end if + + ii = min(iend + 1, nn) + tok = string(ii:ii) + + is_number = tok /= '.' + if (is_number .eqv. was_number) then + call token_error(error, string, istart, ii, & + & "Unexpected token found") + return + end if + + if (.not.is_number) then + is_number = .false. + istart = ii + iend = ii + return + end if + + istart = ii + do ii = min(iend + 1, nn), nn + tok = string(ii:ii) + select case(tok) + case default + call token_error(error, string, istart, ii, & + & "Invalid character in version number") + exit + case('.') + exit + case('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') + iend = ii + cycle + end select + end do + + end subroutine next + + + !> Create an error on an invalid token, provide some visual context as well + subroutine token_error(error, string, istart, iend, message) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> String describing the version information + character(len=*), intent(in) :: string + + !> Start of last token, start of next token on exit + integer, intent(in) :: istart + + !> End of last token on entry, end of next token on exit + integer, intent(in) :: iend + + !> Error message + character(len=*), intent(in) :: message + + character(len=*), parameter :: nl = new_line('a') + + allocate(error) + error%message = message // nl // " | " // string // nl // & + & " |" // repeat('-', istart) // repeat('^', iend - istart + 1) + + end subroutine token_error + + + subroutine to_string(self, string) + + !> Version number + class(version_t), intent(in) :: self + + !> Character representation of the version + character(len=:), allocatable, intent(out) :: string + + integer, parameter :: buffersize = 64 + character(len=buffersize) :: buffer + integer :: ii + + do ii = 1, size(self%num) + if (allocated(string)) then + write(buffer, '(".", i0)') self%num(ii) + string = string // trim(buffer) + else + write(buffer, '(i0)') self%num(ii) + string = trim(buffer) + end if + end do + + if (.not.allocated(string)) then + string = '0' + end if + + end subroutine to_string + + + !> Check to version numbers for equality + elemental function equals(lhs, rhs) result(is_equal) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> Version match + logical :: is_equal + + is_equal = .not.(lhs > rhs) + if (is_equal) then + is_equal = .not.(rhs > lhs) + end if + + end function equals + + + !> Check two versions for inequality + elemental function not_equals(lhs, rhs) result(not_equal) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> Version mismatch + logical :: not_equal + + not_equal = lhs > rhs + if (.not.not_equal) then + not_equal = rhs > lhs + end if + + end function not_equals + + + !> Relative comparison of two versions + elemental function greater(lhs, rhs) result(is_greater) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> First version is greater + logical :: is_greater + + integer :: ii + + do ii = 1, min(size(lhs%num), size(rhs%num)) + is_greater = lhs%num(ii) > rhs%num(ii) + if (is_greater) exit + end do + if (is_greater) return + + is_greater = size(lhs%num) > size(rhs%num) + if (is_greater) then + do ii = size(rhs%num) + 1, size(lhs%num) + is_greater = lhs%num(ii) > 0 + if (is_greater) exit + end do + end if + + end function greater + + + !> Relative comparison of two versions + elemental function less(lhs, rhs) result(is_less) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> First version is less + logical :: is_less + + is_less = rhs > lhs + + end function less + + + !> Relative comparison of two versions + elemental function greater_equals(lhs, rhs) result(is_greater_equal) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> First version is greater or equal + logical :: is_greater_equal + + is_greater_equal = .not. (rhs > lhs) + + end function greater_equals + + + !> Relative comparison of two versions + elemental function less_equals(lhs, rhs) result(is_less_equal) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> First version is less or equal + logical :: is_less_equal + + is_less_equal = .not. (lhs > rhs) + + end function less_equals + + + !> Try to match first version against second version + elemental function match(lhs, rhs) + + !> First version number + class(version_t), intent(in) :: lhs + + !> Second version number + class(version_t), intent(in) :: rhs + + !> Version match following semantic versioning rules + logical :: match + + type(version_t) :: tmp + + match = .not.(rhs > lhs) + if (match) then + tmp%num = rhs%num + tmp%num(size(tmp%num)) = tmp%num(size(tmp%num)) + 1 + match = tmp > lhs + end if + + end function match + + +end module fpm_versioning diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index bc8ad29..6f20a3f 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -6,6 +6,7 @@ program fpm_testing use test_toml, only : collect_toml use test_manifest, only : collect_manifest use test_source_parsing, only : collect_source_parsing + use test_versioning, only : collect_versioning implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name @@ -17,7 +18,8 @@ program fpm_testing testsuite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & - & new_testsuite("fpm_source_parsing", collect_source_parsing) & + & new_testsuite("fpm_source_parsing", collect_source_parsing), & + & new_testsuite("fpm_versioning", collect_versioning) & & ] call get_argument(1, suite_name) diff --git a/fpm/test/fpm_test/test_versioning.f90 b/fpm/test/fpm_test/test_versioning.f90 new file mode 100644 index 0000000..f6dcb57 --- /dev/null +++ b/fpm/test/fpm_test/test_versioning.f90 @@ -0,0 +1,405 @@ +!> Test implementation of version data type +module test_versioning + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_versioning + implicit none + private + + public :: collect_versioning + + +contains + + + !> Collect all exported unit tests + subroutine collect_versioning(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-version", test_valid_version), & + & new_unittest("valid-equals", test_valid_equals), & + & new_unittest("valid-notequals", test_valid_notequals), & + & new_unittest("valid-compare", test_valid_compare), & + & new_unittest("valid-match", test_valid_match), & + & new_unittest("valid-string", test_valid_string), & + & new_unittest("invalid-empty", test_invalid_empty, should_fail=.true.), & + & new_unittest("invalid-version1", test_invalid_version1, should_fail=.true.), & + & new_unittest("invalid-version2", test_invalid_version2, should_fail=.true.), & + & new_unittest("invalid-version3", test_invalid_version3, should_fail=.true.), & + & new_unittest("invalid-overflow", test_invalid_overflow, should_fail=.true.)] + + end subroutine collect_versioning + + + !> Read valid version strings + subroutine test_valid_version(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "8.9.0", error) + if (allocated(error)) return + + call new_version(version, "2020.10.003", error) + + end subroutine test_valid_version + + + !> Compare versions for equality + subroutine test_valid_equals(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: v1, v2 + type(version_t) :: varray(4) + + call new_version(v1, [1, 2, 0]) + call new_version(v2, [1, 2]) + + if (.not. v1 == v2) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v2 == v1) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [0, 9, 0]) + call new_version(v2, [0, 9]) + + if (.not. v1.eq.v2) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v2.eq.v1) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [2020]) + call new_version(v2, [2020, 0]) + + if (.not. v1 == v2) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v2 == v1) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [20, 1]) + call new_version(varray(1), [19]) + call new_version(varray(2), [18, 2]) + call new_version(varray(3), [20, 1]) + call new_version(varray(4), [1, 3, 1]) + + if (.not. any(v1 == varray)) then + call test_failed(error, "Version comparison failed") + return + end if + + end subroutine test_valid_equals + + + !> Compare versions for mismatch + subroutine test_valid_notequals(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: v1, v2 + type(version_t) :: varray(4) + + call new_version(v1, [2020, 3, 1]) + call new_version(v2, [2020, 3]) + + if (.not. v1 /= v2) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v2 /= v1) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [0, 9, 1]) + call new_version(v2, [0, 9]) + + if (.not. v1.ne.v2) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v2.ne.v1) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [2020]) + call new_version(v2, [0, 2020]) + + if (.not. v2 /= v1) then + call test_failed(error, "Version comparison failed") + return + end if + + if (.not. v1 /= v2) then + call test_failed(error, "Version comparison failed") + return + end if + + call new_version(v1, [20, 1]) + call new_version(varray(1), [19]) + call new_version(varray(2), [18, 2]) + call new_version(varray(3), [18, 1]) + call new_version(varray(4), [1, 3, 1]) + + if (.not. any(v1 /= varray)) then + call test_failed(error, "Version comparison failed") + return + end if + + end subroutine test_valid_notequals + + + !> Relative comparison of versions + subroutine test_valid_compare(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: v1, v2 + type(version_t) :: varray(4) + + call new_version(v1, [10]) + call new_version(v2, [1]) + + if (.not. v1 > v2) then + call test_failed(error, "Version comparison failed (gt)") + return + end if + + if (.not. v1 >= v2) then + call test_failed(error, "Version comparison failed (ge)") + return + end if + + if (.not. v2 < v1) then + call test_failed(error, "Version comparison failed (lt)") + return + end if + + if (.not. v2 <= v1) then + call test_failed(error, "Version comparison failed (le)") + return + end if + + call new_version(v1, [1, 0, 8]) + call new_version(v2, [1, 0]) + + if (.not. v1 .gt. v2) then + call test_failed(error, "Version comparison failed (gt)") + return + end if + + if (.not. v1 .ge. v2) then + call test_failed(error, "Version comparison failed (ge)") + return + end if + + if (.not. v2 .lt. v1) then + call test_failed(error, "Version comparison failed (lt)") + return + end if + + if (.not. v2 .le. v1) then + call test_failed(error, "Version comparison failed (le)") + return + end if + + call new_version(v1, [1, 2]) + call new_version(v2, [1, 2, 0]) + + if (v1 > v2) then + call test_failed(error, "Version comparison failed (gt)") + return + end if + + if (.not. v1 >= v2) then + call test_failed(error, "Version comparison failed (ge)") + return + end if + + if (v2 < v1) then + call test_failed(error, "Version comparison failed (lt)") + return + end if + + if (.not. v2 <= v1) then + call test_failed(error, "Version comparison failed (le)") + return + end if + + call new_version(v1, [20, 1]) + call new_version(varray(1), [19]) + call new_version(varray(2), [18, 2]) + call new_version(varray(3), [18, 1]) + call new_version(varray(4), [1, 3, 1]) + + if (.not. all(v1 > varray)) then + call test_failed(error, "Version comparison failed (gt)") + return + end if + + end subroutine test_valid_compare + + + !> Semantic version matching + subroutine test_valid_match(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: v1, v2 + type(version_t) :: varray(4) + + call new_version(v1, [1, 1, 0]) + call new_version(v2, [1]) + + if (.not. (v1 .match. v2)) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + if (v2 .match. v1) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + call new_version(v1, [0, 5, 8]) + call new_version(v2, [0, 5]) + + if (.not. (v1 .match. v2)) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + if (v2 .match. v1) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + call new_version(v1, [1, 2]) + call new_version(v2, [1, 2, 0]) + + if (.not. (v1 .match. v2)) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + if (.not. (v2 .match. v1)) then + call test_failed(error, "Version comparison failed (match)") + return + end if + + end subroutine test_valid_match + + + !> Test if version string is preserved + subroutine test_valid_string(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: str_in = "20.1.100" + character(len=:), allocatable :: str_out + type(version_t) :: version + + call new_version(version, str_in, error) + if (allocated(error)) return + call version%to_string(str_out) + + if (str_in /= str_out) then + call test_failed(error, "Expected "//str_in//" but got "//str_out) + end if + + end subroutine test_valid_string + + + !> Empty string does not represent a version + subroutine test_invalid_empty(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "", error) + + end subroutine test_invalid_empty + + + !> Version is invalid with trailing dots + subroutine test_invalid_version1(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "1.", error) + + end subroutine test_invalid_version1 + + + !> Version is invalid with multiple dots + subroutine test_invalid_version2(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "1..1", error) + + end subroutine test_invalid_version2 + + + !> Version is invalid if it is not a version + subroutine test_invalid_version3(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "one", error) + + end subroutine test_invalid_version3 + + + !> Check if overflows of the internal size constraint are handled gracefully + subroutine test_invalid_overflow(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + call new_version(version, "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0", error) + + end subroutine test_invalid_overflow + + +end module test_versioning -- cgit v1.2.3 From 0fe14b81507be3fe1cd6beda4b960384e813732d Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Wed, 30 Sep 2020 10:29:40 +0100 Subject: Update fpm/src/fpm_filesystem.f90 Co-authored-by: Milan Curcic --- fpm/src/fpm_filesystem.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 0ef844f..2aa9f8b 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -113,7 +113,7 @@ end function canon_path function dirname(path) result (dir) ! Extract dirname from path ! - character(*), intent(In) :: path + character(*), intent(in) :: path character(:), allocatable :: dir character(:), allocatable :: file_parts(:) -- cgit v1.2.3