From d9c985171e8e84d1b0d4ee8b5eef2716064b3855 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Apr 2023 11:44:42 +0200 Subject: [PATCH 01/80] create serializable interface --- src/fpm/toml.f90 | 76 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index f8d8ea2420..9320627240 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -25,8 +25,84 @@ module fpm_toml get_value, set_value, get_list, new_table, add_table, add_array, len, & toml_error, toml_serialize, toml_load, check_keys + !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON + type, abstract, public :: fpm_serializable + + contains + + !> Dump to TOML table + procedure(fpm_to_toml), deferred :: dump_to_toml + + !> Dump TOML to unit/file + procedure, non_overridable :: dump_to_file + procedure, non_overridable :: dump_to_unit + + generic :: dump => dump_to_toml, dump_to_file, dump_to_unit + + end type fpm_serializable + + + abstract interface + + !> Write object to TOML datastructure + subroutine fpm_to_toml(self, table, error) + import fpm_serializable,toml_table,error_t + implicit none + + !> Instance of the dependency tree + class(fpm_serializable), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + end subroutine fpm_to_toml + + end interface + contains + + !> Write serializable object to a formatted Fortran unit + subroutine dump_to_unit(self, unit, error) + !> Instance of the dependency tree + class(fpm_serializable), intent(inout) :: self + !> Formatted unit + integer, intent(in) :: unit + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + + table = toml_table() + call self%dump(table, error) + + write (unit, '(a)') toml_serialize(table) + + call table%destroy() + + end subroutine dump_to_unit + + !> Write serializable object to file + subroutine dump_to_file(self, file, error) + !> Instance of the dependency tree + class(fpm_serializable), intent(inout) :: self + !> File name + character(len=*), intent(in) :: file + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + + open (file=file, newunit=unit) + call self%dump(unit, error) + close (unit) + if (allocated(error)) return + + end subroutine dump_to_file + !> Process the configuration file to a TOML data structure subroutine read_package_file(table, manifest, error) From 71ffdb0cccee01406817bf75df16a22e6951264e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Apr 2023 13:07:58 +0200 Subject: [PATCH 02/80] base serialization api --- src/fpm/toml.f90 | 139 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 124 insertions(+), 15 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 9320627240..ffd2a58d51 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -26,31 +26,41 @@ module fpm_toml toml_error, toml_serialize, toml_load, check_keys !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON - type, abstract, public :: fpm_serializable + type, abstract, public :: serializable_t contains - !> Dump to TOML table - procedure(fpm_to_toml), deferred :: dump_to_toml + !> Dump to TOML table, unit, file + procedure(to_toml), deferred, private :: dump_to_toml + procedure, non_overridable, private :: dump_to_file + procedure, non_overridable, private :: dump_to_unit + generic :: dump => dump_to_toml, dump_to_file, dump_to_unit - !> Dump TOML to unit/file - procedure, non_overridable :: dump_to_file - procedure, non_overridable :: dump_to_unit + !> Load from TOML table, unit, file + procedure(from_toml), deferred, private :: load_from_toml + procedure, non_overridable, private :: load_from_file + procedure, non_overridable, private :: load_from_unit + generic :: load => load_from_toml, load_from_file, load_from_unit - generic :: dump => dump_to_toml, dump_to_file, dump_to_unit + !> Serializable entities need a way to check that they're equal + procedure(is_equal), deferred, private :: serializable_is_same + generic :: operator(==) => serializable_is_same - end type fpm_serializable + !> Test load/write roundtrip + procedure, non_overridable :: test_serialization + + end type serializable_t abstract interface !> Write object to TOML datastructure - subroutine fpm_to_toml(self, table, error) - import fpm_serializable,toml_table,error_t + subroutine to_toml(self, table, error) + import serializable_t,toml_table,error_t implicit none - !> Instance of the dependency tree - class(fpm_serializable), intent(inout) :: self + !> Instance of the serializable object + class(serializable_t), intent(inout) :: self !> Data structure type(toml_table), intent(inout) :: table @@ -58,17 +68,71 @@ subroutine fpm_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - end subroutine fpm_to_toml + end subroutine to_toml + + !> Read dependency tree from TOML data structure + subroutine from_toml(self, table, error) + import serializable_t,toml_table,error_t + implicit none + + !> Instance of the serializable object + class(serializable_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + end subroutine from_toml + + !> Compare two serializable objects + logical function is_equal(this,that) + import serializable_t + class(serializable_t), intent(in) :: this,that + end function is_equal end interface contains + !> Test serialization of a serializable object + subroutine test_serialization(self, error) + class(serializable_t), intent(inout) :: self + type(error_t), allocatable, intent(out) :: error + + integer :: iunit + class(serializable_t), allocatable :: copy + + open(newunit=iunit,form='formatted',status='scratch') + + !> Dump to scratch file + call self%dump(iunit, error) + if (allocated(error)) return + + !> Load from scratch file + rewind(iunit) + allocate(copy,mold=self) + call self%load(iunit,error) + if (allocated(error)) return + close(iunit) + + !> Check same + if (SAME_TYPE_AS(self,copy)) then + if (.not.(self==copy)) then + call fatal_error(error,'serializable object failed TOML write/reread test') + return + end if + end if + deallocate(copy) + + end subroutine test_serialization + !> Write serializable object to a formatted Fortran unit subroutine dump_to_unit(self, unit, error) !> Instance of the dependency tree - class(fpm_serializable), intent(inout) :: self + class(serializable_t), intent(inout) :: self !> Formatted unit integer, intent(in) :: unit !> Error handling @@ -88,7 +152,7 @@ end subroutine dump_to_unit !> Write serializable object to file subroutine dump_to_file(self, file, error) !> Instance of the dependency tree - class(fpm_serializable), intent(inout) :: self + class(serializable_t), intent(inout) :: self !> File name character(len=*), intent(in) :: file !> Error handling @@ -103,6 +167,51 @@ subroutine dump_to_file(self, file, error) end subroutine dump_to_file + !> Read dependency tree from file + subroutine load_from_file(self, file, error) + !> Instance of the dependency tree + class(serializable_t), intent(inout) :: self + !> File name + character(len=*), intent(in) :: file + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + logical :: exist + + inquire (file=file, exist=exist) + if (.not. exist) return + + open (file=file, newunit=unit) + call self%load(unit, error) + close (unit) + end subroutine load_from_file + + !> Read dependency tree from file + subroutine load_from_unit(self, unit, error) + !> Instance of the dependency tree + class(serializable_t), intent(inout) :: self + !> File name + integer, intent(in) :: unit + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_error), allocatable :: parse_error + type(toml_table), allocatable :: table + + call toml_load(table, unit, error=parse_error) + + if (allocated(parse_error)) then + allocate (error) + call move_alloc(parse_error%message, error%message) + return + end if + + call self%load(table, error) + if (allocated(error)) return + + end subroutine load_from_unit + !> Process the configuration file to a TOML data structure subroutine read_package_file(table, manifest, error) From d5ab4526a5b60a6ef6ad426143a5f166e0804fd3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Apr 2023 14:54:00 +0200 Subject: [PATCH 03/80] `git_target_t`: make `serializable_t` --- src/fpm/git.f90 | 110 ++++++++++++++++++++++++++++++++++++++++++++++- src/fpm/toml.f90 | 8 ++-- 2 files changed, 112 insertions(+), 6 deletions(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 36b4702f0b..faaaad7eaf 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -2,6 +2,7 @@ module fpm_git use fpm_error, only: error_t, fatal_error use fpm_filesystem, only : get_temp_filename, getline, join_path + use fpm_toml, only: serializable_t, toml_table, get_value implicit none public :: git_target_t @@ -27,6 +28,9 @@ module fpm_git !> Commit hash integer :: revision = 203 + !> Invalid descriptor + integer :: error = -999 + end type enum_descriptor !> Actual enumerator for descriptors @@ -34,7 +38,7 @@ module fpm_git !> Description of an git target - type :: git_target_t + type, extends(serializable_t) :: git_target_t !> Kind of the git target integer :: descriptor = git_descriptor%default @@ -53,6 +57,11 @@ module fpm_git !> Show information on instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => git_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type git_target_t @@ -146,6 +155,30 @@ logical function git_target_eq(this,that) result(is_equal) end function git_target_eq + !> Check that two git targets are equal + logical function git_is_same(this,that) + class(git_target_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + git_is_same = .false. + + select type (other=>that) + type is (git_target_t) + + if (.not.(this%descriptor==other%descriptor)) return + if (.not.(this%url==other%url)) return + if (.not.(this%object==other%object)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + git_is_same = .true. + + end function git_is_same + !> Check that a cached dependency matches a manifest request logical function git_matches_manifest(cached,manifest) @@ -296,5 +329,80 @@ subroutine info(self, unit, verbosity) end subroutine info + !> Dump dependency to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(git_target_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + stop 'dump_to_toml not yet implemented for class git_target_t' + + end subroutine dump_to_toml + + !> Read dependency from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(git_target_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + character(len=:), allocatable :: descriptor_name + + call get_value(table, "descriptor", descriptor_name) + self%descriptor = parse_descriptor(descriptor_name) + + if (self%descriptor==git_descriptor%error) then + call fatal_error(error,"invalid descriptor ID in TOML entry") + return + end if + + !> Target URL of the git repository + call get_value(table, "url", self%url) + + !> Additional descriptor of the git object + call get_value(table,"object", self%object) + + end subroutine load_from_toml + + !> Parse git descriptor identifier from a string + pure integer function parse_descriptor(name) + character(len=*), intent(in) :: name + + select case (name) + case ("default"); parse_descriptor = git_descriptor%default + case ("branch"); parse_descriptor = git_descriptor%branch + case ("tag"); parse_descriptor = git_descriptor%tag + case ("revision"); parse_descriptor = git_descriptor%revision + case default; parse_descriptor = git_descriptor%error + end select + + end function parse_descriptor + + !> Code git descriptor to a string + pure function descriptor_name(descriptor) result(name) + integer, intent(in) :: descriptor + character(len=:), allocatable :: name + + select case (descriptor) + case (git_descriptor%default); name = "default" + case (git_descriptor%branch); name = "branch" + case (git_descriptor%tag); name = "tag" + case (git_descriptor%revision); name = "revision" + case default; name = "ERROR" + end select + + end function descriptor_name end module fpm_git diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index ffd2a58d51..e303766c40 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -118,11 +118,9 @@ subroutine test_serialization(self, error) close(iunit) !> Check same - if (SAME_TYPE_AS(self,copy)) then - if (.not.(self==copy)) then - call fatal_error(error,'serializable object failed TOML write/reread test') - return - end if + if (.not.(self==copy)) then + call fatal_error(error,'serializable object failed TOML write/reread test') + return end if deallocate(copy) From b798e1476bdd5e5cf5068852b9a864721d5a347e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Apr 2023 15:23:25 +0200 Subject: [PATCH 04/80] `git_target_t` serialization test --- src/fpm/git.f90 | 24 ++++++++++++++++++++++-- src/fpm/toml.f90 | 7 ++++--- test/fpm_test/test_toml.f90 | 35 ++++++++++++++++++++++++++++++++++- 3 files changed, 60 insertions(+), 6 deletions(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index faaaad7eaf..5e668cd8f2 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -2,7 +2,7 @@ module fpm_git use fpm_error, only: error_t, fatal_error use fpm_filesystem, only : get_temp_filename, getline, join_path - use fpm_toml, only: serializable_t, toml_table, get_value + use fpm_toml, only: serializable_t, toml_table, get_value, set_value implicit none public :: git_target_t @@ -341,7 +341,24 @@ subroutine dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - stop 'dump_to_toml not yet implemented for class git_target_t' + integer :: ierr + + call set_value(table, "descriptor", descriptor_name(self%descriptor)) + if (allocated(self%url)) then + call set_value(table, "url", self%url, ierr) + if (ierr/=0) then + call fatal_error(error,'git_target_t: cannot set url in TOML table') + return + end if + endif + + if (allocated(self%object)) then + call set_value(table, "object", self%object, ierr) + if (ierr/=0) then + call fatal_error(error,'git_target_t: cannot set object in TOML table') + return + end if + endif end subroutine dump_to_toml @@ -374,6 +391,9 @@ subroutine load_from_toml(self, table, error) !> Additional descriptor of the git object call get_value(table,"object", self%object) + call info(self,unit=6,verbosity=10) + + end subroutine load_from_toml !> Parse git descriptor identifier from a string diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index e303766c40..246bfc27a4 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -97,8 +97,9 @@ end function is_equal contains !> Test serialization of a serializable object - subroutine test_serialization(self, error) + subroutine test_serialization(self, message, error) class(serializable_t), intent(inout) :: self + character(len=*), intent(in) :: message type(error_t), allocatable, intent(out) :: error integer :: iunit @@ -113,13 +114,13 @@ subroutine test_serialization(self, error) !> Load from scratch file rewind(iunit) allocate(copy,mold=self) - call self%load(iunit,error) + call copy%load(iunit,error) if (allocated(error)) return close(iunit) !> Check same if (.not.(self==copy)) then - call fatal_error(error,'serializable object failed TOML write/reread test') + call fatal_error(error,'serializable object failed TOML write/reread test: '//trim(message)) return end if deallocate(copy) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 1ffea1d651..8aa09c85da 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -2,6 +2,7 @@ module test_toml use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml + use fpm_git implicit none private @@ -20,7 +21,8 @@ subroutine collect_toml(testsuite) testsuite = [ & & new_unittest("valid-toml", test_valid_toml), & & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & - & new_unittest("missing-file", test_missing_file, should_fail=.true.)] + & new_unittest("missing-file", test_missing_file, should_fail=.true.), & + & new_unittest("serialize-git-target", git_target_roundtrip_1)] end subroutine collect_toml @@ -103,5 +105,36 @@ subroutine test_missing_file(error) end subroutine test_missing_file + !> Test git_target_t serialization + subroutine git_target_roundtrip_1(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + type(git_target_t) :: git + + ! Revision type + git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & + sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") + call git%test_serialization("git_target_roundtrip_1",error) + if (allocated(error)) return + + ! Branch type + git = git_target_branch(url="https://github.com/urbanjost/M_CLI2.git", & + branch="main") + call git%test_serialization("git_target_roundtrip_1",error) + if (allocated(error)) return + + ! Branch type + git = git_target_tag(url="https://github.com/urbanjost/M_CLI2.git", & + tag="1.0.0") + call git%test_serialization("git_target_roundtrip_1",error) + if (allocated(error)) return + + end subroutine git_target_roundtrip_1 + + end module test_toml From 0fbeb0a79371e4ca6156e5b8b5b427254badc778 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 10:01:58 +0200 Subject: [PATCH 05/80] `git_target_t` tests --- test/fpm_test/test_toml.f90 | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 8aa09c85da..dcbd4abbfb 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -22,7 +22,7 @@ subroutine collect_toml(testsuite) & new_unittest("valid-toml", test_valid_toml), & & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & & new_unittest("missing-file", test_missing_file, should_fail=.true.), & - & new_unittest("serialize-git-target", git_target_roundtrip_1)] + & new_unittest("serialize-git-target", git_target_roundtrip)] end subroutine collect_toml @@ -106,7 +106,7 @@ subroutine test_missing_file(error) end subroutine test_missing_file !> Test git_target_t serialization - subroutine git_target_roundtrip_1(error) + subroutine git_target_roundtrip(error) !> Error handling type(error_t), allocatable, intent(out) :: error @@ -118,22 +118,32 @@ subroutine git_target_roundtrip_1(error) ! Revision type git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") - call git%test_serialization("git_target_roundtrip_1",error) + call git%test_serialization("revision git type",error) if (allocated(error)) return ! Branch type git = git_target_branch(url="https://github.com/urbanjost/M_CLI2.git", & branch="main") - call git%test_serialization("git_target_roundtrip_1",error) + call git%test_serialization("branch git type",error) if (allocated(error)) return - ! Branch type + ! Tag type git = git_target_tag(url="https://github.com/urbanjost/M_CLI2.git", & tag="1.0.0") - call git%test_serialization("git_target_roundtrip_1",error) + call git%test_serialization("target git type",error) + if (allocated(error)) return + + ! Incomplete type + if (allocated(git%object)) deallocate(git%object) + call git%test_serialization("incomplete git type 1/2",error) + if (allocated(error)) return + + ! Incomplete type + if (allocated(git%url)) deallocate(git%url) + call git%test_serialization("incomplete git type 2/2",error) if (allocated(error)) return - end subroutine git_target_roundtrip_1 + end subroutine git_target_roundtrip From 4bca99b8407ad9335605eaba6fbd878f64c92089 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 10:51:36 +0200 Subject: [PATCH 06/80] `dependency_config_t`: implement `serializable_t` --- src/fpm/git.f90 | 9 +- src/fpm/manifest/dependency.f90 | 170 +++++++++++++++++++++++++++++++- 2 files changed, 169 insertions(+), 10 deletions(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 61e8719bd3..64cca94188 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -2,7 +2,7 @@ module fpm_git use fpm_error, only: error_t, fatal_error use fpm_filesystem, only : get_temp_filename, getline, join_path - use fpm_toml, only: serializable_t, toml_table, get_value, set_value + use fpm_toml, only: serializable_t, toml_table, get_value, set_value, toml_stat implicit none public :: git_target_t @@ -357,7 +357,7 @@ subroutine dump_to_toml(self, table, error) call set_value(table, "descriptor", descriptor_name(self%descriptor)) if (allocated(self%url)) then call set_value(table, "url", self%url, ierr) - if (ierr/=0) then + if (ierr/=toml_stat%success) then call fatal_error(error,'git_target_t: cannot set url in TOML table') return end if @@ -365,7 +365,7 @@ subroutine dump_to_toml(self, table, error) if (allocated(self%object)) then call set_value(table, "object", self%object, ierr) - if (ierr/=0) then + if (ierr/=toml_stat%success) then call fatal_error(error,'git_target_t: cannot set object in TOML table') return end if @@ -402,9 +402,6 @@ subroutine load_from_toml(self, table, error) !> Additional descriptor of the git object call get_value(table,"object", self%object) - call info(self,unit=6,verbosity=10) - - end subroutine load_from_toml !> Parse git descriptor identifier from a string diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 1ca53bc9cf..1a14b2ef16 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -23,20 +23,22 @@ !> Resolving a dependency will result in obtaining a new package configuration !> data for the respective project. module fpm_manifest_dependency - use fpm_error, only: error_t, syntax_error + use fpm_error, only: error_t, syntax_error, fatal_error use fpm_git, only: git_target_t, git_target_tag, git_target_branch, & & git_target_revision, git_target_default, operator(==), git_matches_manifest - use fpm_toml, only: toml_table, toml_key, toml_stat, get_value, check_keys + use fpm_toml, only: toml_table, toml_key, toml_stat, get_value, check_keys, serializable_t, add_table, & + & set_value use fpm_filesystem, only: windows_path use fpm_environment, only: get_os_type, OS_WINDOWS use fpm_versioning, only: version_t, new_version implicit none private - public :: dependency_config_t, new_dependency, new_dependencies, manifest_has_changed + public :: dependency_config_t, new_dependency, new_dependencies, manifest_has_changed, & + & dependency_destroy !> Configuration meta data for a dependency - type :: dependency_config_t + type, extends(serializable_t) :: dependency_config_t !> Name of the dependency character(len=:), allocatable :: name @@ -61,6 +63,11 @@ module fpm_manifest_dependency !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => dependency_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type dependency_config_t !> Common output format for writing to the command line @@ -301,5 +308,160 @@ logical function manifest_has_changed(cached, manifest, verbosity, iunit) result end function manifest_has_changed + !> Clean memory + elemental subroutine dependency_destroy(self) + class(dependency_config_t), intent(inout) :: self + + if (allocated(self%name)) deallocate(self%name) + if (allocated(self%path)) deallocate(self%path) + if (allocated(self%namespace)) deallocate(self%namespace) + if (allocated(self%requested_version)) deallocate(self%requested_version) + if (allocated(self%git)) deallocate(self%git) + + end subroutine dependency_destroy + + !> Check that two dependency configs are equal + logical function dependency_is_same(this,that) + class(dependency_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + dependency_is_same = .false. + + select type (other=>that) + type is (dependency_config_t) + + if (.not.(this%name==other%name)) return + if (.not.(this%path==other%path)) return + if (.not.(this%namespace==other%namespace)) return + if (.not.(allocated(this%requested_version).eqv.allocated(other%requested_version))) return + if (allocated(this%requested_version)) then + if (.not.(this%requested_version==other%requested_version)) return + endif + + if (.not.(allocated(this%git).eqv.allocated(other%git))) return + if (allocated(this%git)) then + if (.not.(this%git==other%git)) return + endif + + class default + ! Not the same type + return + end select + + !> All checks passed! + dependency_is_same = .true. + + end function dependency_is_same + + !> Dump dependency to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(toml_table), pointer :: ptr + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + if (allocated(self%name)) then + call set_value(table, "name", self%name, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot set name in TOML table') + return + end if + endif + + if (allocated(self%path)) then + call set_value(table, "path", self%path, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot set path in TOML table') + return + end if + endif + + if (allocated(self%namespace)) then + call set_value(table, "namespace", self%namespace, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot set namespace in TOML table') + return + end if + endif + + if (allocated(self%requested_version)) then + call set_value(table, "requested_version", self%requested_version%s(), ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot set requested_version in TOML table') + return + end if + endif + + + if (allocated(self%git)) then + call add_table(table, "git", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot set git table in TOML table') + return + end if + + call self%git%dump_to_toml(ptr, error) + if (allocated(error)) return + endif + + end subroutine dump_to_toml + + !> Read dependency from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + type(toml_key), allocatable :: list(:) + type(toml_table), pointer :: ptr + character(len=:), allocatable :: requested_version + integer :: ierr,ii + + call dependency_destroy(self) + + call get_value(table, "name", self%name) + call get_value(table, "path", self%path) + call get_value(table, "namespace", self%namespace) + call get_value(table, "requested_version", requested_version) + if (allocated(requested_version)) then + allocate(self%requested_version) + call new_version(self%requested_version, requested_version, error) + if (allocated(error)) then + error%message = 'dependency_config_t: version error from TOML table - '//error%message + return + endif + end if + + call table%get_keys(list) + add_git: do ii = 1, size(list) + if (list(ii)%key=="git") then + call get_value(table, list(ii)%key, ptr, stat=ierr) + if (ierr /= toml_stat%success) then + call fatal_error(error,'dependency_config_t: cannot retrieve git from TOML table') + exit + endif + allocate(self%git) + call self%git%load_from_toml(ptr, error) + if (allocated(error)) return + exit add_git + end if + end do add_git + + end subroutine load_from_toml end module fpm_manifest_dependency From 65833ff3217d6d3d0bb9c914bf8fdb8de064d912 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 10:51:47 +0200 Subject: [PATCH 07/80] test `dependency_config_t` serialization --- test/fpm_test/test_toml.f90 | 58 ++++++++++++++++++++++++++++++++++++- 1 file changed, 57 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index dcbd4abbfb..723777e30c 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -3,6 +3,8 @@ module test_toml use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml use fpm_git + use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy + use fpm_versioning, only: new_version implicit none private @@ -22,7 +24,8 @@ subroutine collect_toml(testsuite) & new_unittest("valid-toml", test_valid_toml), & & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & & new_unittest("missing-file", test_missing_file, should_fail=.true.), & - & new_unittest("serialize-git-target", git_target_roundtrip)] + & new_unittest("serialize-git-target", git_target_roundtrip), & + & new_unittest("serialize-dependency-config", dependency_config_roundtrip)] end subroutine collect_toml @@ -146,5 +149,58 @@ subroutine git_target_roundtrip(error) end subroutine git_target_roundtrip + !> Test git_target_t serialization + subroutine dependency_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + type(dependency_config_t) :: dep + + call dependency_destroy(dep) + + dep%name = "M_CLI2" + dep%path = "~/./some/dummy/path" + dep%namespace = "urbanjost" + allocate(dep%requested_version) + call new_version(dep%requested_version, "3.2.0",error); if (allocated(error)) return + + allocate(dep%git) + dep%git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & + sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") + + ! Test full object + call dep%test_serialization("full object",error) + if (allocated(error)) return + + ! Remove namespace + deallocate(dep%namespace) + call dep%test_serialization("no namespace",error) + if (allocated(error)) return + + ! Remove git + deallocate(dep%git) + call dep%test_serialization("no git",error) + if (allocated(error)) return + + ! Remove version + deallocate(dep%requested_version) + call dep%test_serialization("no version",error) + if (allocated(error)) return + + ! Remove name + deallocate(dep%name) + call dep%test_serialization("no name",error) + if (allocated(error)) return + + ! Remove path + deallocate(dep%path) + call dep%test_serialization("no path",error) + if (allocated(error)) return + + end subroutine dependency_config_roundtrip + end module test_toml From 0a1e97efce468e194ff37df3e8513329fcbe559a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 11:20:20 +0200 Subject: [PATCH 08/80] `dependency_node_t`: implement `serializable_t` --- src/fpm/dependency.f90 | 172 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 168 insertions(+), 4 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index d89b6eb836..5947ea9497 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -58,10 +58,12 @@ module fpm_dependency use, intrinsic :: iso_fortran_env, only: output_unit use fpm_environment, only: get_os_type, OS_WINDOWS, os_is_unix use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only: exists, join_path, mkdir, canon_path, windows_path, list_files, is_dir, basename, os_delete_dir - use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==) + use fpm_filesystem, only: exists, join_path, mkdir, canon_path, windows_path, list_files, is_dir, & + basename, os_delete_dir + use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==), & + serializable_t use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data - use fpm_manifest_dependency, only: manifest_has_changed + use fpm_manifest_dependency, only: manifest_has_changed, dependency_destroy use fpm_strings, only: string_t, operator(.in.) use fpm_toml, only: toml_table, toml_key, toml_error, toml_serialize, & get_value, set_value, add_table, toml_load, toml_stat @@ -74,7 +76,7 @@ module fpm_dependency private public :: dependency_tree_t, new_dependency_tree, dependency_node_t, new_dependency_node, resize, & - & check_and_read_pkg_data + & check_and_read_pkg_data, destroy_dependency_node !> Overloaded reallocation interface interface resize @@ -103,6 +105,13 @@ module fpm_dependency procedure, private :: get_from_local_registry !> Print information on this instance procedure :: info + + !> Serialization interface + procedure :: serializable_is_same => dependency_node_is_same + procedure :: dump_to_toml => node_dump_to_toml + procedure :: load_from_toml => node_load_from_toml + + end type dependency_node_t !> Respresentation of a projects dependencies @@ -1225,4 +1234,159 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu end function dependency_has_changed + !> Check that two dependency nodes are equal + logical function dependency_node_is_same(this,that) + class(dependency_node_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + dependency_node_is_same = .false. + + select type (other=>that) + type is (dependency_node_t) + + ! Base class must match + if (.not.(this%dependency_config_t==other%dependency_config_t)) return + + ! Extension must match + if (.not.(this%done .eqv.other%done)) return + if (.not.(this%update.eqv.other%update)) return + if (.not.(this%cached.eqv.other%cached)) return + if (.not.(this%proj_dir==other%proj_dir)) return + if (.not.(this%revision==other%revision)) return + + if (.not.(allocated(this%version).eqv.allocated(other%version))) return + if (allocated(this%version)) then + if (.not.(this%version==other%version)) return + endif + + class default + ! Not the same type + return + end select + + !> All checks passed! + dependency_node_is_same = .true. + + end function dependency_node_is_same + + !> Dump dependency to toml table + subroutine node_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_node_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(toml_table), pointer :: ptr + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + ! Dump parent class + call self%dependency_config_t%dump_to_toml(table, error) + if (allocated(error)) return + + if (allocated(self%version)) then + call set_value(table, "version", self%version%s(), ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set version in TOML table') + return + end if + endif + + if (allocated(self%proj_dir)) then + call set_value(table, "proj_dir", self%proj_dir, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set proj_dir in TOML table') + return + end if + endif + + if (allocated(self%revision)) then + call set_value(table, "revision", self%revision, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set revision in TOML table') + return + end if + endif + + call set_value(table, "done", self%done, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set done in TOML table') + return + end if + + call set_value(table, "update", self%update, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set update in TOML table') + return + end if + + call set_value(table, "cached", self%cached, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot set cached in TOML table') + return + end if + + end subroutine node_dump_to_toml + + !> Read dependency from toml table (no checks made at this stage) + subroutine node_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_node_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + character(len=:), allocatable :: version + + call destroy_dependency_node(self) + + ! Load parent class + call self%dependency_config_t%load_from_toml(table, error) + if (allocated(error)) return + + call get_value(table, "done", self%done) + call get_value(table, "update", self%update) + call get_value(table, "cached", self%cached) + call get_value(table, "proj_dir", self%proj_dir) + call get_value(table, "revision", self%revision) + + call get_value(table, "version", version) + if (allocated(version)) then + allocate(self%version) + call new_version(self%version, version, error) + if (allocated(error)) then + error%message = 'dependency_node_t: version error from TOML table - '//error%message + return + endif + end if + + end subroutine node_load_from_toml + + !> Destructor + elemental subroutine destroy_dependency_node(self) + + class(dependency_node_t), intent(inout) :: self + + integer :: ierr + + call dependency_destroy(self) + + deallocate(self%version,stat=ierr) + deallocate(self%proj_dir,stat=ierr) + deallocate(self%revision,stat=ierr) + self%done = .false. + self%update = .false. + self%cached = .false. + + end subroutine destroy_dependency_node + end module fpm_dependency From b3cba476c685adb6dd5841c8db13115ef8ff8479 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 11:20:33 +0200 Subject: [PATCH 09/80] test `dependency_node_t` serialization --- test/fpm_test/test_toml.f90 | 81 ++++++++++++++++++++++++++++++++++++- 1 file changed, 79 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 723777e30c..2f61c3b1ca 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -3,8 +3,10 @@ module test_toml use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml use fpm_git + use fpm_dependency, only: dependency_node_t, destroy_dependency_node use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version + implicit none private @@ -25,7 +27,8 @@ subroutine collect_toml(testsuite) & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & & new_unittest("missing-file", test_missing_file, should_fail=.true.), & & new_unittest("serialize-git-target", git_target_roundtrip), & - & new_unittest("serialize-dependency-config", dependency_config_roundtrip)] + & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & + & new_unittest("serialize-dependency-node", dependency_node_roundtrip)] end subroutine collect_toml @@ -187,7 +190,7 @@ subroutine dependency_config_roundtrip(error) ! Remove version deallocate(dep%requested_version) - call dep%test_serialization("no version",error) + call dep%test_serialization("no requested_version",error) if (allocated(error)) return ! Remove name @@ -202,5 +205,79 @@ subroutine dependency_config_roundtrip(error) end subroutine dependency_config_roundtrip + !> Test dependency_node_t serialization + subroutine dependency_node_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + type(dependency_node_t) :: dep + + call destroy_dependency_node(dep) + + dep%name = "M_CLI2" + dep%path = "~/./some/dummy/path" + dep%proj_dir = "~/./" + dep%namespace = "urbanjost" + dep%revision = "7264878cdb1baff7323cc48596d829ccfe7751b8" + dep%cached = .true. + dep%done = .false. + dep%update = .true. + allocate(dep%requested_version) + call new_version(dep%requested_version, "3.2.0",error); if (allocated(error)) return + allocate(dep%version) + call new_version(dep%version, "4.53.2",error); if (allocated(error)) return + + allocate(dep%git) + dep%git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & + sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") + + ! Test full object + call dep%test_serialization("full object",error) + if (allocated(error)) return + + ! Remove namespace + deallocate(dep%namespace) + call dep%test_serialization("no namespace",error) + if (allocated(error)) return + + ! Remove git + deallocate(dep%git) + call dep%test_serialization("no git",error) + if (allocated(error)) return + + ! Remove version + deallocate(dep%requested_version) + call dep%test_serialization("no requested_version",error) + if (allocated(error)) return + + ! Remove name + deallocate(dep%name) + call dep%test_serialization("no name",error) + if (allocated(error)) return + + ! Remove path + deallocate(dep%path) + call dep%test_serialization("no path",error) + if (allocated(error)) return + + ! Remove revision + deallocate(dep%revision) + call dep%test_serialization("no revision",error) + if (allocated(error)) return + + ! Remove proj_dir + deallocate(dep%proj_dir) + call dep%test_serialization("no proj_dir",error) + if (allocated(error)) return + + ! Remove version + deallocate(dep%version) + call dep%test_serialization("no version",error) + if (allocated(error)) return + + end subroutine dependency_node_roundtrip end module test_toml From bcffaaa40b455ed7dfe24cb73704a3138c389ade Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 11:27:33 +0200 Subject: [PATCH 10/80] rename `proj_dir` key to `proj-dir` --- src/fpm/dependency.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 5947ea9497..43cfb65575 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -111,7 +111,6 @@ module fpm_dependency procedure :: dump_to_toml => node_dump_to_toml procedure :: load_from_toml => node_load_from_toml - end type dependency_node_t !> Respresentation of a projects dependencies @@ -183,6 +182,7 @@ module fpm_dependency procedure, private :: update_dependency !> Update all dependencies in the tree procedure, private :: update_tree + end type dependency_tree_t !> Common output format for writing to the command line @@ -1297,7 +1297,7 @@ subroutine node_dump_to_toml(self, table, error) endif if (allocated(self%proj_dir)) then - call set_value(table, "proj_dir", self%proj_dir, ierr) + call set_value(table, "proj-dir", self%proj_dir, ierr) if (ierr/=toml_stat%success) then call fatal_error(error,'dependency_node_t: cannot set proj_dir in TOML table') return @@ -1356,7 +1356,7 @@ subroutine node_load_from_toml(self, table, error) call get_value(table, "done", self%done) call get_value(table, "update", self%update) call get_value(table, "cached", self%cached) - call get_value(table, "proj_dir", self%proj_dir) + call get_value(table, "proj-dir", self%proj_dir) call get_value(table, "revision", self%revision) call get_value(table, "version", version) From 5f5b4d94262ce23fac2aef29c64e4226b0afdf65 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 11:33:34 +0200 Subject: [PATCH 11/80] keep former cache interface; rename to `load_cache()`, `dump_cache()` --- src/fpm/dependency.f90 | 52 ++++++++++----------- test/fpm_test/test_package_dependencies.f90 | 18 +++---- 2 files changed, 35 insertions(+), 35 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 43cfb65575..7e60a22e08 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -161,21 +161,21 @@ module fpm_dependency !> Depedendncy resolution finished procedure :: finished !> Reading of dependency tree - generic :: load => load_from_file, load_from_unit, load_from_toml + generic :: load_cache => load_cache_from_file, load_cache_from_unit, load_cache_from_toml !> Read dependency tree from file - procedure, private :: load_from_file + procedure, private :: load_cache_from_file !> Read dependency tree from formatted unit - procedure, private :: load_from_unit + procedure, private :: load_cache_from_unit !> Read dependency tree from TOML data structure - procedure, private :: load_from_toml + procedure, private :: load_cache_from_toml !> Writing of dependency tree - generic :: dump => dump_to_file, dump_to_unit, dump_to_toml + generic :: dump_cache => dump_cache_to_file, dump_cache_to_unit, dump_cache_to_toml !> Write dependency tree to file - procedure, private :: dump_to_file + procedure, private :: dump_cache_to_file !> Write dependency tree to formatted unit - procedure, private :: dump_to_unit + procedure, private :: dump_cache_to_unit !> Write dependency tree to TOML data structure - procedure, private :: dump_to_toml + procedure, private :: dump_cache_to_toml !> Update dependency tree generic :: update => update_dependency, update_tree !> Update a list of dependencies @@ -320,7 +320,7 @@ subroutine add_project(self, package, error) ! After resolving all dependencies, check if we have cached ones to avoid updates if (allocated(self%cache)) then call new_dependency_tree(cached, verbosity=self%verbosity,cache=self%cache) - call cached%load(self%cache, error) + call cached%load_cache(self%cache, error) if (allocated(error)) return ! Skip root node @@ -339,7 +339,7 @@ subroutine add_project(self, package, error) if (allocated(error)) return if (allocated(self%cache)) then - call self%dump(self%cache, error) + call self%dump_cache(self%cache, error) if (allocated(error)) return end if @@ -969,7 +969,7 @@ subroutine register(self, package, root, fetch, revision, error) end subroutine register !> Read dependency tree from file - subroutine load_from_file(self, file, error) + subroutine load_cache_from_file(self, file, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> File name @@ -984,12 +984,12 @@ subroutine load_from_file(self, file, error) if (.not. exist) return open (file=file, newunit=unit) - call self%load(unit, error) + call self%load_cache(unit, error) close (unit) - end subroutine load_from_file + end subroutine load_cache_from_file !> Read dependency tree from file - subroutine load_from_unit(self, unit, error) + subroutine load_cache_from_unit(self, unit, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> File name @@ -1008,13 +1008,13 @@ subroutine load_from_unit(self, unit, error) return end if - call self%load(table, error) + call self%load_cache(table, error) if (allocated(error)) return - end subroutine load_from_unit + end subroutine load_cache_from_unit !> Read dependency tree from TOML data structure - subroutine load_from_toml(self, table, error) + subroutine load_cache_from_toml(self, table, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Data structure @@ -1076,10 +1076,10 @@ subroutine load_from_toml(self, table, error) if (allocated(error)) return self%ndep = size(list) - end subroutine load_from_toml + end subroutine load_cache_from_toml !> Write dependency tree to file - subroutine dump_to_file(self, file, error) + subroutine dump_cache_to_file(self, file, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> File name @@ -1090,14 +1090,14 @@ subroutine dump_to_file(self, file, error) integer :: unit open (file=file, newunit=unit) - call self%dump(unit, error) + call self%dump_cache(unit, error) close (unit) if (allocated(error)) return - end subroutine dump_to_file + end subroutine dump_cache_to_file !> Write dependency tree to file - subroutine dump_to_unit(self, unit, error) + subroutine dump_cache_to_unit(self, unit, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Formatted unit @@ -1108,14 +1108,14 @@ subroutine dump_to_unit(self, unit, error) type(toml_table) :: table table = toml_table() - call self%dump(table, error) + call self%dump_cache(table, error) write (unit, '(a)') toml_serialize(table) - end subroutine dump_to_unit + end subroutine dump_cache_to_unit !> Write dependency tree to TOML datastructure - subroutine dump_to_toml(self, table, error) + subroutine dump_cache_to_toml(self, table, error) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Data structure @@ -1152,7 +1152,7 @@ subroutine dump_to_toml(self, table, error) end do if (allocated(error)) return - end subroutine dump_to_toml + end subroutine dump_cache_to_toml !> Reallocate a list of dependencies pure subroutine resize_dependency_node(var, n) diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 3c5b0ee021..425e124dd4 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -105,13 +105,13 @@ subroutine test_cache_dump_load(error) call new_dependency_node(deps%dep(3), dep, proj_dir=dep%path) open (newunit=unit, status='scratch') - call deps%dump(unit, error) + call deps%dump_cache(unit, error) if (.not. allocated(error)) then rewind (unit) call new_dependency_tree(deps) call resize(deps%dep, 2) - call deps%load(unit, error) + call deps%load_cache(unit, error) close (unit) end if if (allocated(error)) return @@ -152,7 +152,7 @@ subroutine test_cache_load_dump(error) call set_value(ptr, "proj-dir", "fpm-tmp4-dir") call new_dependency_tree(deps) - call deps%load(table, error) + call deps%load_cache(table, error) if (allocated(error)) return if (deps%ndep /= 4) then @@ -163,7 +163,7 @@ subroutine test_cache_load_dump(error) call table%destroy table = toml_table() - call deps%dump(table, error) + call deps%dump_cache(table, error) if (allocated(error)) return call table%get_keys(list) @@ -194,7 +194,7 @@ subroutine test_status(error) call set_value(ptr, "git", "https://github.com/fortran-lang/dep2") call new_dependency_tree(deps) - call deps%load(table, error) + call deps%load_cache(table, error) if (allocated(error)) return if (deps%finished()) then @@ -285,7 +285,7 @@ subroutine test_non_updated_dependencies(error) ! Load into a dependency tree call new_dependency_tree(cached) - call cached%load(cache, error) + call cached%load_cache(cache, error) if (allocated(error)) return ! Mark all dependencies as "cached" do ii=1,cached%ndep @@ -309,7 +309,7 @@ subroutine test_non_updated_dependencies(error) ! Load dependencies from manifest call new_dependency_tree(manifest_deps) - call manifest_deps%load(manifest, error) + call manifest_deps%load_cache(manifest, error) call manifest%destroy() if (allocated(error)) return @@ -369,7 +369,7 @@ subroutine test_update_dependencies(error) ! Load into a dependency tree call new_dependency_tree(cached) - call cached%load(cache, error) + call cached%load_cache(cache, error) if (allocated(error)) return ! Mark all dependencies as "cached" do ii=1,cached%ndep @@ -393,7 +393,7 @@ subroutine test_update_dependencies(error) ! Load dependencies from manifest call new_dependency_tree(manifest_deps) - call manifest_deps%load(manifest, error) + call manifest_deps%load_cache(manifest, error) call manifest%destroy() if (allocated(error)) return From a827bcac2e0bf6884818c3c388e377682504b824 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 12:47:11 +0200 Subject: [PATCH 12/80] `dependency_tree_t`: implement `serializable_t` --- src/fpm/dependency.f90 | 178 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 176 insertions(+), 2 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 7e60a22e08..45c9cc44ce 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -117,7 +117,7 @@ module fpm_dependency !> !> The dependencies are stored in a simple array for now, this can be replaced !> with a binary-search tree or a hash table in the future. - type :: dependency_tree_t + type, extends(serializable_t) :: dependency_tree_t !> Unit for IO integer :: unit = output_unit !> Verbosity of printout @@ -183,6 +183,11 @@ module fpm_dependency !> Update all dependencies in the tree procedure, private :: update_tree + !> Serialization interface + procedure :: serializable_is_same => dependency_tree_is_same + procedure :: dump_to_toml => tree_dump_to_toml + procedure :: load_from_toml => tree_load_from_toml + end type dependency_tree_t !> Common output format for writing to the command line @@ -1279,7 +1284,6 @@ subroutine node_dump_to_toml(self, table, error) type(toml_table), intent(inout) :: table !> Error handling - type(toml_table), pointer :: ptr type(error_t), allocatable, intent(out) :: error integer :: ierr @@ -1389,4 +1393,174 @@ elemental subroutine destroy_dependency_node(self) end subroutine destroy_dependency_node + !> Check that two dependency trees are equal + logical function dependency_tree_is_same(this,that) + class(dependency_tree_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + dependency_tree_is_same = .false. + + select type (other=>that) + type is (dependency_tree_t) + + if (.not.(this%unit==other%unit)) return + if (.not.(this%verbosity==other%verbosity)) return + if (.not.(this%dep_dir==other%dep_dir)) return + if (.not.(this%ndep==other%ndep)) return + if (.not.(allocated(this%dep).eqv.allocated(other%dep))) return + if (allocated(this%dep)) then + if (.not.(size(this%dep)==size(other%dep))) return + do ii = 1, size(this%dep) + if (.not.(this%dep(ii)==other%dep(ii))) return + end do + endif + if (.not.(this%cache==other%cache)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + dependency_tree_is_same = .true. + + end function dependency_tree_is_same + + !> Dump dependency to toml table + subroutine tree_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_tree_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr, ii + type(toml_table), pointer :: ptr_deps,ptr + character(27) :: unnamed + + call set_value(table, "unit", self%unit, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set unit in TOML table') + return + end if + call set_value(table, "verbosity", self%verbosity, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set verbosity in TOML table') + return + end if + if (allocated(self%dep_dir)) then + call set_value(table, "dep-dir", self%dep_dir, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set dep-dir in TOML table') + return + end if + endif + if (allocated(self%cache)) then + call set_value(table, "cache", self%cache, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set cache in TOML table') + return + end if + endif + call set_value(table, "ndep", self%ndep, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set ndep in TOML table') + return + end if + + if (allocated(self%dep)) then + + ! Create dependency table + call add_table(table, "dependencies", ptr_deps) + if (.not. associated(ptr_deps)) then + call fatal_error(error, "dependency_tree_t cannot create dependency table ") + return + end if + + do ii = 1, size(self%dep) + associate (dep => self%dep(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(dep%name)==0) then + write(unnamed,1) ii + call add_table(ptr_deps, trim(unnamed), ptr) + else + call add_table(ptr_deps, dep%name, ptr) + end if + if (.not. associated(ptr)) then + call fatal_error(error, "dependency_tree_t cannot create entry for dependency "//dep%name) + return + end if + call dep%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + + endif + + 1 format('UNNAMED_DEPENDENCY_',i0) + + end subroutine tree_dump_to_toml + + !> Read dependency from toml table (no checks made at this stage) + subroutine tree_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(dependency_tree_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + type(toml_key), allocatable :: keys(:),dep_keys(:) + type(toml_table), pointer :: ptr_deps,ptr + integer :: ii, jj, ierr + + call table%get_keys(keys) + + call get_value(table, "unit", self%unit) + call get_value(table, "verbosity", self%verbosity) + call get_value(table, "ndep", self%ndep) + call get_value(table, "dep-dir", self%dep_dir) + call get_value(table, "cache", self%cache) + + find_deps_table: do ii = 1, size(keys) + if (keys(ii)%key=="dependencies") then + + call get_value(table, keys(ii), ptr_deps) + if (.not.associated(ptr_deps)) then + call fatal_error(error,'dependency_tree_t: error retrieving dependency table from TOML table') + return + end if + + !> Read all dependencies + call ptr_deps%get_keys(dep_keys) + call resize(self%dep, size(dep_keys)) + + do jj = 1, size(dep_keys) + + call get_value(ptr_deps, dep_keys(jj), ptr) + call self%dep(jj)%load_from_toml(ptr, error) + if (allocated(error)) return + + end do + + exit find_deps_table + + endif + end do find_deps_table + + end subroutine tree_load_from_toml + + end module fpm_dependency From fd46ac09b0c676f08e76217d910d8c36ca54e7cf Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 12:47:24 +0200 Subject: [PATCH 13/80] test `dependency_tree_t` serialization --- test/fpm_test/test_toml.f90 | 81 +++++++++++++++++++++++++++++++++---- 1 file changed, 73 insertions(+), 8 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 2f61c3b1ca..8d3774dff8 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -3,7 +3,8 @@ module test_toml use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml use fpm_git - use fpm_dependency, only: dependency_node_t, destroy_dependency_node + use fpm_dependency, only: dependency_node_t, destroy_dependency_node, dependency_tree_t, & + & new_dependency_node, new_dependency_tree, resize use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version @@ -28,7 +29,8 @@ subroutine collect_toml(testsuite) & new_unittest("missing-file", test_missing_file, should_fail=.true.), & & new_unittest("serialize-git-target", git_target_roundtrip), & & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & - & new_unittest("serialize-dependency-node", dependency_node_roundtrip)] + & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & + & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip)] end subroutine collect_toml @@ -117,8 +119,6 @@ subroutine git_target_roundtrip(error) !> Error handling type(error_t), allocatable, intent(out) :: error - type(toml_table), allocatable :: table - type(git_target_t) :: git ! Revision type @@ -158,8 +158,6 @@ subroutine dependency_config_roundtrip(error) !> Error handling type(error_t), allocatable, intent(out) :: error - type(toml_table), allocatable :: table - type(dependency_config_t) :: dep call dependency_destroy(dep) @@ -211,8 +209,6 @@ subroutine dependency_node_roundtrip(error) !> Error handling type(error_t), allocatable, intent(out) :: error - type(toml_table), allocatable :: table - type(dependency_node_t) :: dep call destroy_dependency_node(dep) @@ -280,4 +276,73 @@ subroutine dependency_node_roundtrip(error) end subroutine dependency_node_roundtrip + !> Test dependency_tree_t serialization + subroutine dependency_tree_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(dependency_tree_t) :: deps + type(dependency_config_t) :: dep + + integer, parameter :: ALLOCATED_DEPS = 5 + character(36) :: msg + integer :: ii + + ! Generate dummy tree with ndep=3 but 5 allocated dependencies + call new_dependency_tree(deps) + call resize(deps%dep, ALLOCATED_DEPS) + deps%ndep = 3 + dep%name = "dep1" + dep%path = "fpm-tmp1-dir" + call new_dependency_node(deps%dep(1), dep, proj_dir=dep%path) + dep%name = "dep2" + dep%path = "fpm-tmp2-dir" + call new_dependency_node(deps%dep(2), dep, proj_dir=dep%path) + deps%dep(3)%name = "M_CLI2" + deps%dep(3)%path = "~/./some/dummy/path" + deps%dep(3)%proj_dir = "~/./" + deps%dep(3)%namespace = "urbanjost" + deps%dep(3)%revision = "7264878cdb1baff7323cc48596d829ccfe7751b8" + deps%dep(3)%cached = .true. + deps%dep(3)%done = .false. + deps%dep(3)%update = .true. + allocate(deps%dep(3)%requested_version) + call new_version(deps%dep(3)%requested_version, "3.2.0",error); if (allocated(error)) return + allocate(deps%dep(3)%version) + call new_version(deps%dep(3)%version, "4.53.2",error); if (allocated(error)) return + allocate(deps%dep(3)%git) + deps%dep(3)%git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & + sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") + + call deps%test_serialization("full dependency tree", error) + if (allocated(error)) then + print *, error%message + stop 'catastrophic' + end if + + ! Remove dependencies (including all them) + do ii = 1, ALLOCATED_DEPS + write(msg,1) ii + call resize(deps%dep, size(deps%dep) - 1) + call deps%test_serialization(trim(msg), error) + if (allocated(error)) return + end do + + ! deallocate dependencies + deallocate(deps%dep) + call deps%test_serialization("unallocated deps(:)", error) + if (allocated(error)) return + + ! Remove deps dir + deallocate(deps%dep_dir) + call deps%test_serialization("no deps dir", error) + if (allocated(error)) return + + + + 1 format('removed ',i0,' dependencies') + + end subroutine dependency_tree_roundtrip + end module test_toml From 7263519acc7cb7d308d31c454886fd754b24d20f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 13:06:28 +0200 Subject: [PATCH 14/80] strings: write 0D, 1D comparison operators --- src/fpm_strings.f90 | 53 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index f8dc4e6daf..d164f76ad2 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -44,6 +44,7 @@ module fpm_strings public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob public :: notabs +public :: operator(==) !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & @@ -89,6 +90,11 @@ module fpm_strings module procedure f_string, f_string_cptr, f_string_cptr_n end interface f_string +interface operator(==) + module procedure string_is_same + module procedure string_arrays_same +end interface + contains !> test if a CHARACTER string ends with a specified suffix @@ -1219,6 +1225,53 @@ logical function has_valid_standard_prefix(module_name,package_name) result(vali end function has_valid_standard_prefix +!> Check that two string _objects_ are exactly identical +pure logical function string_is_same(this,that) + !> two strings to be compared + type(string_t), intent(in) :: this, that + + integer :: i + + string_is_same = .false. + + if (allocated(this%s).neqv.allocated(that%s)) return + if (allocated(this%s)) then + if (.not.len(this%s)==len(that%s)) return + if (.not.len_trim(this%s)==len_trim(that%s)) return + do i=1,len_trim(this%s) + if (.not.(this%s(i:i)==that%s(i:i))) return + end do + end if + + ! All checks passed + string_is_same = .true. + +end function string_is_same + +!> Check that two allocatable string _object_ arrays are exactly identical +pure logical function string_arrays_same(this,that) + !> two string arrays to be compared + type(string_t), allocatable, intent(in) :: this(:), that(:) + + integer :: i + + string_arrays_same = .false. + + if (allocated(this).neqv.allocated(that)) return + if (allocated(this)) then + if (.not.(size(this)==size(that))) return + if (.not.(ubound(this,1)==ubound(that,1))) return + if (.not.(lbound(this,1)==lbound(that,1))) return + do i=lbound(this,1),ubound(this,1) + if (.not.string_is_same(this(i),that(i))) return + end do + end if + + ! All checks passed + string_arrays_same = .true. + +end function string_arrays_same + !> !!### NAME !! notabs(3f) - [fpm_strings:NONALPHA] expand tab characters From a519fb572562742a94ac4e68f8f74c74f57fb8cd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 13:52:36 +0200 Subject: [PATCH 15/80] `FPM_SCOPE` and `FPM_UNIT`: standardize labels --- src/fpm_model.f90 | 75 +++++++++++++++++++++++------------------------ 1 file changed, 36 insertions(+), 39 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index dba15a8161..d19b9d0f7d 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -38,7 +38,6 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t -use fpm_strings, only: string_t, str, len_trim implicit none private @@ -249,23 +248,7 @@ function info_srcfile(source) result(s) ! character(:), allocatable :: exe_name s = s // ', exe_name="' // source%exe_name // '"' ! integer :: unit_scope = FPM_SCOPE_UNKNOWN - s = s // ", unit_scope=" - select case(source%unit_scope) - case (FPM_SCOPE_UNKNOWN) - s = s // "FPM_SCOPE_UNKNOWN" - case (FPM_SCOPE_LIB) - s = s // "FPM_SCOPE_LIB" - case (FPM_SCOPE_DEP) - s = s // "FPM_SCOPE_DEP" - case (FPM_SCOPE_APP) - s = s // "FPM_SCOPE_APP" - case (FPM_SCOPE_TEST) - s = s // "FPM_SCOPE_TEST" - case (FPM_SCOPE_EXAMPLE) - s = s // "FPM_SCOPE_EXAMPLE" - case default - s = s // "INVALID" - end select + s = s // ', unit_scope="' // FPM_SCOPE_NAME(source%unit_scope) // '"' ! type(string_t), allocatable :: modules_provided(:) s = s // ", modules_provided=[" do i = 1, size(source%modules_provided) @@ -280,27 +263,7 @@ function info_srcfile(source) result(s) end do s = s // "]" ! integer :: unit_type = FPM_UNIT_UNKNOWN - s = s // ", unit_type=" - select case(source%unit_type) - case (FPM_UNIT_UNKNOWN) - s = s // "FPM_UNIT_UNKNOWN" - case (FPM_UNIT_PROGRAM) - s = s // "FPM_UNIT_PROGRAM" - case (FPM_UNIT_MODULE) - s = s // "FPM_UNIT_MODULE" - case (FPM_UNIT_SUBMODULE) - s = s // "FPM_UNIT_SUBMODULE" - case (FPM_UNIT_SUBPROGRAM) - s = s // "FPM_UNIT_SUBPROGRAM" - case (FPM_UNIT_CSOURCE) - s = s // "FPM_UNIT_CSOURCE" - case (FPM_UNIT_CPPSOURCE) - s = s // "FPM_UNIT_CPPSOURCE" - case (FPM_UNIT_CHEADER) - s = s // "FPM_UNIT_CHEADER" - case default - s = s // "INVALID" - end select + s = s // ', unit_type="' // FPM_UNIT_NAME(source%unit_type) // '"' ! type(string_t), allocatable :: modules_used(:) s = s // ", modules_used=[" do i = 1, size(source%modules_used) @@ -396,4 +359,38 @@ subroutine show_model(model) print *, info_model(model) end subroutine show_model +!> Return the character name of a scope flag +function FPM_SCOPE_NAME(flag) result(name) + integer, intent(in) :: flag + character(len=:), allocatable :: name + + select case (flag) + case (FPM_SCOPE_UNKNOWN); name = "FPM_SCOPE_UNKNOWN" + case (FPM_SCOPE_LIB); name = "FPM_SCOPE_LIB" + case (FPM_SCOPE_DEP); name = "FPM_SCOPE_DEP" + case (FPM_SCOPE_APP); name = "FPM_SCOPE_APP" + case (FPM_SCOPE_TEST); name = "FPM_SCOPE_TEST" + case (FPM_SCOPE_EXAMPLE); name = "FPM_SCOPE_EXAMPLE" + case default; name = "INVALID" + end select +end function FPM_SCOPE_NAME + +!> Return the character name of a unit flag +function FPM_UNIT_NAME(flag) result(name) + integer, intent(in) :: flag + character(len=:), allocatable :: name + + select case (flag) + case (FPM_UNIT_UNKNOWN); name = "FPM_SCOPE_UNKNOWN" + case (FPM_UNIT_PROGRAM); name = "FPM_UNIT_PROGRAM" + case (FPM_UNIT_MODULE); name = "FPM_UNIT_MODULE" + case (FPM_UNIT_SUBMODULE); name = "FPM_UNIT_SUBMODULE" + case (FPM_UNIT_SUBPROGRAM); name = "FPM_UNIT_SUBPROGRAM" + case (FPM_UNIT_CSOURCE); name = "FPM_UNIT_CSOURCE" + case (FPM_UNIT_CPPSOURCE); name = "FPM_UNIT_CPPSOURCE" + case (FPM_UNIT_CHEADER); name = "FPM_UNIT_CHEADER" + case default; name = "INVALID" + end select +end function FPM_UNIT_NAME + end module fpm_model From bef96c5a06899f8c3e32b6b6d68ae87da04b3a86 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 14:00:54 +0200 Subject: [PATCH 16/80] `FPM_SCOPE` and `FPM_UNIT` parsers --- src/fpm_model.f90 | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index d19b9d0f7d..7c4515db28 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -38,6 +38,7 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t +use fpm_strings, only: string_t, str, len_trim, lower implicit none private @@ -375,6 +376,27 @@ function FPM_SCOPE_NAME(flag) result(name) end select end function FPM_SCOPE_NAME +!> Parse git FPM_SCOPE identifier from a string +integer function parse_scope(name) result(scope) + character(len=*), intent(in) :: name + + character(len=len(name)) :: lowercase + + !> Make it Case insensitive + lowercase = lower(name) + + select case (trim(lowercase)) + case ("FPM_SCOPE_UNKNOWN"); scope = FPM_SCOPE_UNKNOWN + case ("FPM_SCOPE_LIB"); scope = FPM_SCOPE_LIB + case ("FPM_SCOPE_DEP"); scope = FPM_SCOPE_DEP + case ("FPM_SCOPE_APP"); scope = FPM_SCOPE_APP + case ("FPM_SCOPE_TEST"); scope = FPM_SCOPE_TEST + case ("FPM_SCOPE_EXAMPLE"); scope = FPM_SCOPE_EXAMPLE + case default; scope = -9999 + end select + +end function parse_scope + !> Return the character name of a unit flag function FPM_UNIT_NAME(flag) result(name) integer, intent(in) :: flag @@ -393,4 +415,27 @@ function FPM_UNIT_NAME(flag) result(name) end select end function FPM_UNIT_NAME +!> Parse git FPM_UNIT identifier from a string +integer function parse_unit(name) result(unit) + character(len=*), intent(in) :: name + + character(len=len(name)) :: lowercase + + !> Make it Case insensitive + lowercase = lower(name) + + select case (trim(lowercase)) + case ("FPM_UNIT_UNKNOWN"); unit = FPM_UNIT_UNKNOWN + case ("FPM_UNIT_PROGRAM"); unit = FPM_UNIT_PROGRAM + case ("FPM_UNIT_MODULE"); unit = FPM_UNIT_MODULE + case ("FPM_UNIT_SUBMODULE"); unit = FPM_UNIT_SUBMODULE + case ("FPM_UNIT_SUBPROGRAM"); unit = FPM_UNIT_SUBPROGRAM + case ("FPM_UNIT_CSOURCE"); unit = FPM_UNIT_CSOURCE + case ("FPM_UNIT_CPPSOURCE"); unit = FPM_UNIT_CPPSOURCE + case ("FPM_UNIT_CHEADER"); unit = FPM_UNIT_CHEADER + case default; unit = -9999 + end select + +end function parse_unit + end module fpm_model From 9c5888a525790581d565463270d0cc52bf5e2b11 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 14:40:45 +0200 Subject: [PATCH 17/80] `string_t` array: implement and test toml `set_list` --- src/fpm/toml.f90 | 62 ++++++++++++++++++++++++++++- test/fpm_test/test_toml.f90 | 78 ++++++++++++++++++++++++++++++++++++- 2 files changed, 138 insertions(+), 2 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 246bfc27a4..d0be9743b5 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -23,7 +23,7 @@ module fpm_toml public :: read_package_file, toml_table, toml_array, toml_key, toml_stat, & get_value, set_value, get_list, new_table, add_table, add_array, len, & - toml_error, toml_serialize, toml_load, check_keys + toml_error, toml_serialize, toml_load, check_keys, set_list !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON type, abstract, public :: serializable_t @@ -293,6 +293,66 @@ subroutine get_list(table, key, list, error) end subroutine get_list + ! Set string array + subroutine set_list(table, key, list, error) + + !> Instance of the string array + type(string_t), allocatable, intent(in) :: list(:) + + !> Key to save to + character(len=*), intent(in) :: key + + !> Instance of the toml table + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + integer :: stat, ilist + type(toml_array), pointer :: children + character(len=:), allocatable :: str + + !> Set no key if array is not present + if (.not.allocated(list)) return + + !> Check the key is not empty + if (len_trim(key)<=0) then + call fatal_error(error, 'key is empty dumping string array to TOML table') + return + end if + + if (size(list)/=1) then ! includes empty list case + + !> String array + call add_array(table, key, children, stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Cannot set array table in "//key//" field") + return + end if + + do ilist = 1, size(list) + call set_value(children, ilist, list(ilist)%s, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Cannot store array entry in "//key//" field") + return + end if + end do + + else + + ! Single value: set string + call set_value(table, key, list(1)%s, stat=stat) + + if (stat /= toml_stat%success) & + call fatal_error(error, "Cannot store entry in "//key//" field") + + return + end if + + end subroutine set_list + + !> Check if table contains only keys that are part of the list. If a key is !> found that is not part of the list, an error is allocated. subroutine check_keys(table, valid_keys, error) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 8d3774dff8..20f63b5259 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -7,6 +7,7 @@ module test_toml & new_dependency_node, new_dependency_tree, resize use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version + use fpm_strings, only: string_t, operator(==), split implicit none private @@ -30,7 +31,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-git-target", git_target_roundtrip), & & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & - & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip)] + & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & + & new_unittest("serialize-string-array", string_array_roundtrip)] end subroutine collect_toml @@ -345,4 +347,78 @@ subroutine dependency_tree_roundtrip(error) end subroutine dependency_tree_roundtrip + !> Test serialization/deserialization of a string array + subroutine string_array_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: lorem = "Lorem ipsum dolor sit amet, consectetur adipiscing " & + & //"elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad " & + & //"minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo " & + & //"consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum " & + & //"dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt " & + & //"in culpa qui officia deserunt mollit anim id est laborum" + + integer :: ii, nword + character(len=:), allocatable :: tokens(:) + type(string_t), allocatable :: list(:),copy(:) + type(toml_table) :: table + character(len=16) :: key + + call split(lorem, tokens) + nword = size(tokens) + + !> Convert to string_t array + allocate(list(nword)) + do ii = 1, nword + list(ii) = string_t(trim(tokens(ii))) + end do + + ! Test list with any length + do ii = nword, 1, -1 + + ! Shorten list + list = list(1:ii) + + ! Set list to table + table = toml_table() + + call set_list(table, key="lorem-ipsum", list=list, error=error) + if (allocated(error)) return + + ! Load list from table + call get_list(table, key="lorem-ipsum", list=copy, error=error) + if (allocated(error)) return + + if (.not.(list==copy)) then + call fatal_error(error,'string_array is not equal after TOML roundtrip') + return + end if + + end do + + ! Test empty list + deallocate(list) + allocate(list(0)) + ! Set list to table + table = toml_table() + + call set_list(table, key="lorem-ipsum", list=list, error=error) + if (allocated(error)) return + + ! Load list from table + call get_list(table, key="lorem-ipsum", list=copy, error=error) + if (allocated(error)) return + + if (.not.(list==copy)) then + call fatal_error(error,'empty string_array is not equal after TOML roundtrip') + return + end if + + 1 format('word_',i0) + + + end subroutine string_array_roundtrip + end module test_toml From 5c9b3bec12632e52df7843b3354dc43ab887e813 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 15:15:24 +0200 Subject: [PATCH 18/80] strings: add uppercase function --- src/fpm_strings.f90 | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index d164f76ad2..20b004b1c0 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -39,7 +39,7 @@ module fpm_strings implicit none private -public :: f_string, lower, split, str_ends_with, string_t, str_begins_with_str +public :: f_string, lower, upper, split, str_ends_with, string_t, str_begins_with_str public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob @@ -274,6 +274,37 @@ elemental pure function lower(str,begin,end) result (string) end function lower + !!License: Public Domain + !! Changes a string to upprtcase over optional specified column range +elemental pure function upper(str,begin,end) result (string) + + character(*), intent(In) :: str + character(len(str)) :: string + integer,intent(in),optional :: begin, end + integer :: i + integer :: ibegin, iend + string = str + + ibegin = 1 + if (present(begin))then + ibegin = max(ibegin,begin) + endif + + iend = len_trim(str) + if (present(end))then + iend= min(iend,end) + endif + + do i = ibegin, iend ! step thru each letter in the string in specified range + select case (str(i:i)) + case ('a':'z') + string(i:i) = char(iachar(str(i:i))-32) ! change letter to capitalized + case default + end select + end do + +end function upper + !> Helper function to generate a new string_t instance !> (Required due to the allocatable component) function new_string_t(s) result(string) From 9c348b1a08712f7b8e06ad0940e5add5c31cc71f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 15:15:51 +0200 Subject: [PATCH 19/80] `string_t` array: add deallocated array test --- test/fpm_test/test_toml.f90 | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 20f63b5259..c847dce22e 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -416,8 +416,23 @@ subroutine string_array_roundtrip(error) return end if - 1 format('word_',i0) + ! Test unallocated list + deallocate(list) + table = toml_table() + + call set_list(table, key="lorem-ipsum", list=list, error=error) + if (allocated(error)) return + ! Load list from table + call get_list(table, key="lorem-ipsum", list=copy, error=error) + if (allocated(error)) return + + if (.not.(list==copy)) then + call fatal_error(error,'deallocated string_array is not equal after TOML roundtrip') + return + end if + + 1 format('word_',i0) end subroutine string_array_roundtrip From 1d9e4aef143d5b41e5fdc7385659adff79c594a3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 15:16:13 +0200 Subject: [PATCH 20/80] `srcfile_t`: implement `serializable_t` --- src/fpm_model.f90 | 159 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 150 insertions(+), 9 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 7c4515db28..a97212bf61 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -38,7 +38,9 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t -use fpm_strings, only: string_t, str, len_trim, lower +use fpm_strings, only: string_t, str, len_trim, upper, operator(==) +use fpm_toml, only: serializable_t, toml_table, toml_stat, set_value, set_list, get_value, get_list +use fpm_error, only: error_t, fatal_error implicit none private @@ -93,7 +95,7 @@ module fpm_model end type fortran_features_t !> Type for describing a source file -type srcfile_t +type, extends(serializable_t) :: srcfile_t !> File path relative to cwd character(:), allocatable :: file_name @@ -124,6 +126,14 @@ module fpm_model !> Current hash integer(int64) :: digest + contains + + !> Serialization interface + procedure :: serializable_is_same => srcfile_is_same + procedure :: dump_to_toml => srcfile_dump_to_toml + procedure :: load_from_toml => srcfile_load_from_toml + + end type srcfile_t @@ -380,12 +390,12 @@ end function FPM_SCOPE_NAME integer function parse_scope(name) result(scope) character(len=*), intent(in) :: name - character(len=len(name)) :: lowercase + character(len=len(name)) :: uppercase !> Make it Case insensitive - lowercase = lower(name) + uppercase = upper(name) - select case (trim(lowercase)) + select case (trim(uppercase)) case ("FPM_SCOPE_UNKNOWN"); scope = FPM_SCOPE_UNKNOWN case ("FPM_SCOPE_LIB"); scope = FPM_SCOPE_LIB case ("FPM_SCOPE_DEP"); scope = FPM_SCOPE_DEP @@ -403,7 +413,7 @@ function FPM_UNIT_NAME(flag) result(name) character(len=:), allocatable :: name select case (flag) - case (FPM_UNIT_UNKNOWN); name = "FPM_SCOPE_UNKNOWN" + case (FPM_UNIT_UNKNOWN); name = "FPM_UNIT_UNKNOWN" case (FPM_UNIT_PROGRAM); name = "FPM_UNIT_PROGRAM" case (FPM_UNIT_MODULE); name = "FPM_UNIT_MODULE" case (FPM_UNIT_SUBMODULE); name = "FPM_UNIT_SUBMODULE" @@ -419,12 +429,12 @@ end function FPM_UNIT_NAME integer function parse_unit(name) result(unit) character(len=*), intent(in) :: name - character(len=len(name)) :: lowercase + character(len=len(name)) :: uppercase !> Make it Case insensitive - lowercase = lower(name) + uppercase = upper(name) - select case (trim(lowercase)) + select case (trim(uppercase)) case ("FPM_UNIT_UNKNOWN"); unit = FPM_UNIT_UNKNOWN case ("FPM_UNIT_PROGRAM"); unit = FPM_UNIT_PROGRAM case ("FPM_UNIT_MODULE"); unit = FPM_UNIT_MODULE @@ -438,4 +448,135 @@ integer function parse_unit(name) result(unit) end function parse_unit +!> Check that two source files are equal +logical function srcfile_is_same(this,that) + class(srcfile_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + srcfile_is_same = .false. + + select type (other=>that) + type is (srcfile_t) + + if (.not.(this%file_name==other%file_name)) return + if (.not.(this%exe_name==other%exe_name)) return + if (.not.(this%unit_scope==other%unit_scope)) return + if (.not.(this%modules_provided==other%modules_provided)) return + if (.not.(this%unit_type==other%unit_type)) return + if (.not.(this%parent_modules==other%parent_modules)) return + if (.not.(this%modules_used==other%modules_used)) return + if (.not.(this%include_dependencies==other%include_dependencies)) return + if (.not.(this%link_libraries==other%link_libraries)) return + if (.not.(this%digest==other%digest)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + srcfile_is_same = .true. + +end function srcfile_is_same + +!> Dump dependency to toml table +subroutine srcfile_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(srcfile_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + if (allocated(self%file_name)) then + call set_value(table, "file-name", self%file_name, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'srcfile_t: cannot set file-name in TOML table') + return + end if + endif + + if (allocated(self%exe_name)) then + call set_value(table, "exe-name", self%exe_name, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'srcfile_t: cannot set exe-name in TOML table') + return + end if + endif + + call set_value(table,"digest",self%digest) + + ! unit_scope and unit_type are saved as strings so the output is independent + ! of the internal representation + call set_value(table,"unit-scope",FPM_SCOPE_NAME(self%unit_scope)) + call set_value(table,"unit-type",FPM_UNIT_NAME(self%unit_type)) + + call set_list(table,"modules-provided",self%modules_provided, error) + if (allocated(error)) return + + call set_list(table,"parent-modules",self%parent_modules, error) + if (allocated(error)) return + + call set_list(table,"modules-used",self%modules_used, error) + if (allocated(error)) return + + call set_list(table,"include-dependencies",self%include_dependencies, error) + if (allocated(error)) return + + call set_list(table,"link-libraries",self%link_libraries, error) + if (allocated(error)) return + + +end subroutine srcfile_dump_to_toml + +!> Read dependency from toml table (no checks made at this stage) +subroutine srcfile_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(srcfile_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: flag + + call get_value(table, "file-name", self%file_name) + call get_value(table, "exe-name", self%exe_name) + call get_value(table, "digest", self%digest) + + ! unit_scope and unit_type are saved as strings so the output is independent + ! of the internal representation + call get_value(table, "unit-scope", flag) + if (allocated(flag)) self%unit_scope = parse_scope(flag) + call get_value(table, "unit-type", flag) + if (allocated(flag)) self%unit_type = parse_unit(flag) + + call get_list(table,"modules-provided",self%modules_provided, error) + if (allocated(error)) return + + call get_list(table,"parent-modules",self%parent_modules, error) + if (allocated(error)) return + + call get_list(table,"modules-used",self%modules_used, error) + if (allocated(error)) return + + call get_list(table,"include-dependencies",self%include_dependencies, error) + if (allocated(error)) return + + call get_list(table,"link-libraries",self%link_libraries, error) + if (allocated(error)) return + + + +end subroutine srcfile_load_from_toml + + end module fpm_model From 413c723e0d372a40a03b406319864b435b95bf97 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 15:16:22 +0200 Subject: [PATCH 21/80] test `srcfile_t` serialization --- test/fpm_test/test_source_parsing.f90 | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index b480e76c33..45fc5c6474 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -117,6 +117,8 @@ subroutine test_modules_used(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_modules_used @@ -184,6 +186,8 @@ subroutine test_intrinsic_modules_used(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_intrinsic_modules_used @@ -241,6 +245,8 @@ subroutine test_include_stmt(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_include_stmt !> Try to parse a simple fortran program @@ -296,6 +302,8 @@ subroutine test_program(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_program @@ -378,6 +386,8 @@ subroutine test_module(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_module @@ -427,6 +437,8 @@ subroutine test_module_with_subprogram(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_module_with_subprogram @@ -492,6 +504,8 @@ subroutine test_module_end_stmt(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_module_end_stmt @@ -540,6 +554,8 @@ subroutine test_module_with_c_api(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_module_with_c_api @@ -603,6 +619,8 @@ subroutine test_program_with_module(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_program_with_module @@ -660,6 +678,8 @@ subroutine test_submodule(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_submodule @@ -717,6 +737,8 @@ subroutine test_submodule_ancestor(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_submodule_ancestor @@ -765,6 +787,8 @@ subroutine test_subprogram(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_subprogram @@ -835,6 +859,8 @@ subroutine test_csource(error) return end if + call f_source%test_serialization('srcfile_t: serialization', error) + end subroutine test_csource !> Try to parse fortran program with invalid use statement From c27febfd630b94f8bc51b5f56bb488bd6501d072 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 16:58:57 +0200 Subject: [PATCH 22/80] extend `package_t` --- src/fpm_model.f90 | 88 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 86 insertions(+), 2 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index a97212bf61..f7ad0d8c3b 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -92,6 +92,7 @@ module fpm_model !> Form to use for all Fortran sources character(:), allocatable :: source_form + end type fortran_features_t !> Type for describing a source file @@ -133,12 +134,11 @@ module fpm_model procedure :: dump_to_toml => srcfile_dump_to_toml procedure :: load_from_toml => srcfile_load_from_toml - end type srcfile_t !> Type for describing a single package -type package_t +type, extends(serializable_t) :: package_t !> Name of package character(:), allocatable :: name @@ -161,6 +161,13 @@ module fpm_model !> Language features type(fortran_features_t) :: features + contains + + !> Serialization interface + procedure :: serializable_is_same => package_is_same + procedure :: dump_to_toml => package_dump_to_toml + procedure :: load_from_toml => package_load_from_toml + end type package_t @@ -578,5 +585,82 @@ subroutine srcfile_load_from_toml(self, table, error) end subroutine srcfile_load_from_toml +!> Check that two package objects are equal +logical function package_is_same(this,that) + class(package_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + package_is_same = .false. + + select type (other=>that) + type is (package_t) + + if (.not.(this%name==other%name)) return + if (.not.(allocated(this%sources).eqv.allocated(other%sources))) return + if (allocated(this%sources)) then + if (.not.(size(this%sources)==size(other%sources))) return + do ii = 1, size(this%sources) + if (.not.(this%sources(ii)==other%sources(ii))) return + end do + end if + + if (.not.(this%macros==other%macros)) return + if (.not.(this%version==other%version)) return + + !> Module naming + if (.not.(this%enforce_module_names.eqv.other%enforce_module_names)) return + if (.not.(this%module_prefix==other%module_prefix)) return + + !> Fortran features + if (.not.(this%features%implicit_typing.eqv.other%features%implicit_typing)) return + if (.not.(this%features%implicit_external.eqv.other%features%implicit_external)) return + if (.not.(this%features%source_form==other%features%source_form)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + package_is_same = .true. + +end function package_is_same + +!> Dump dependency to toml table +subroutine package_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(package_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call fatal_error(error,' not yet implemented ' ) + +end subroutine package_dump_to_toml + +!> Read dependency from toml table (no checks made at this stage) +subroutine package_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(package_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: flag + + call fatal_error(error, ' not yet implemented ') + +end subroutine package_load_from_toml + end module fpm_model From b649d2df84fe239962994b0cb112cb04edb4e368 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 17:01:57 +0200 Subject: [PATCH 23/80] extend `fortran_features_t` --- src/fpm_model.f90 | 71 ++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 67 insertions(+), 4 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index f7ad0d8c3b..235496d397 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -82,7 +82,7 @@ module fpm_model integer, parameter :: FPM_SCOPE_EXAMPLE = 5 !> Enabled Fortran language features -type :: fortran_features_t +type, extends(serializable_t) :: fortran_features_t !> Use default implicit typing logical :: implicit_typing = .false. @@ -93,6 +93,13 @@ module fpm_model !> Form to use for all Fortran sources character(:), allocatable :: source_form + contains + + !> Serialization interface + procedure :: serializable_is_same => fft_is_same + procedure :: dump_to_toml => fft_dump_to_toml + procedure :: load_from_toml => fft_load_from_toml + end type fortran_features_t !> Type for describing a source file @@ -585,6 +592,64 @@ subroutine srcfile_load_from_toml(self, table, error) end subroutine srcfile_load_from_toml +!> Check that two fortran feature objects are equal +logical function fft_is_same(this,that) + class(fortran_features_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + fft_is_same = .false. + + select type (other=>that) + type is (fortran_features_t) + + if (.not.(this%implicit_typing.eqv.other%implicit_typing)) return + if (.not.(this%implicit_external.eqv.other%implicit_external)) return + if (.not.(this%source_form==other%source_form)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + fft_is_same = .true. + +end function fft_is_same + +!> Dump fortran features to toml table +subroutine fft_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(fortran_features_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call fatal_error(error,' fortran-features-t serialization not yet implemented ' ) + +end subroutine fft_dump_to_toml + +!> Read dependency from toml table (no checks made at this stage) +subroutine fft_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(fortran_features_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: flag + + call fatal_error(error, ' fortran-features-t serialization not yet implemented ') + +end subroutine fft_load_from_toml + !> Check that two package objects are equal logical function package_is_same(this,that) class(package_t), intent(in) :: this @@ -614,9 +679,7 @@ logical function package_is_same(this,that) if (.not.(this%module_prefix==other%module_prefix)) return !> Fortran features - if (.not.(this%features%implicit_typing.eqv.other%features%implicit_typing)) return - if (.not.(this%features%implicit_external.eqv.other%features%implicit_external)) return - if (.not.(this%features%source_form==other%features%source_form)) return + if (.not.(this%features==other%features)) return class default ! Not the same type From f0201c1a81fb85dac04c8dc5235f2d2aae028231 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 17:24:10 +0200 Subject: [PATCH 24/80] `fortran_features_t`: implement serialization and test --- src/fpm_model.f90 | 41 +++++++++++++++++++++++++++++++++---- test/fpm_test/test_toml.f90 | 23 ++++++++++++++++++++- 2 files changed, 59 insertions(+), 5 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 235496d397..ee8692f5b6 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -588,8 +588,6 @@ subroutine srcfile_load_from_toml(self, table, error) call get_list(table,"link-libraries",self%link_libraries, error) if (allocated(error)) return - - end subroutine srcfile_load_from_toml !> Check that two fortran feature objects are equal @@ -628,7 +626,27 @@ subroutine fft_dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call fatal_error(error,' fortran-features-t serialization not yet implemented ' ) + integer :: ierr + + call set_value(table, "implicit-typing", self%implicit_typing, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fortran_features_t: cannot set implicit-typing in TOML table') + return + end if + + call set_value(table, "implicit-external", self%implicit_external, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fortran_features_t: cannot set implicit-external in TOML table') + return + end if + + if (allocated(self%source_form)) then + call set_value(table, "source-form", self%source_form, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fortran_features_t: cannot set source-form in TOML table') + return + end if + endif end subroutine fft_dump_to_toml @@ -646,7 +664,22 @@ subroutine fft_load_from_toml(self, table, error) character(len=:), allocatable :: flag - call fatal_error(error, ' fortran-features-t serialization not yet implemented ') + integer :: ierr + + call get_value(table, "implicit-typing", self%implicit_typing, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fortran_features_t: cannot read implicit-typing from TOML table') + return + end if + + call get_value(table, "implicit-external", self%implicit_external, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fortran_features_t: cannot read implicit-typing from TOML table') + return + end if + + ! Return unallocated value if not present + call get_value(table, "source-form", self%source_form) end subroutine fft_load_from_toml diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index c847dce22e..317ed906ab 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -8,6 +8,7 @@ module test_toml use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split + use fpm_model, only: fortran_features_t implicit none private @@ -32,7 +33,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & - & new_unittest("serialize-string-array", string_array_roundtrip)] + & new_unittest("serialize-string-array", string_array_roundtrip), & + & new_unittest("serialize-fortran-features", fft_roundtrip)] end subroutine collect_toml @@ -436,4 +438,23 @@ subroutine string_array_roundtrip(error) end subroutine string_array_roundtrip + !> Test serialization/deserialization of a fortran-features structure + subroutine fft_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fortran_features_t) :: fortran + + !> Default object + call fortran%test_serialization('fortran_features_t: default object',error) + if (allocated(error)) return + + !> Set form + fortran%source_form = "free" + call fortran%test_serialization('fortran_features_t: with form',error) + if (allocated(error)) return + + end subroutine fft_roundtrip + end module test_toml From d7f2f10918f42c7bb82cbd8b2459cb7459dd9054 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 18:35:17 +0200 Subject: [PATCH 25/80] set_string wrappers to reduce verbosity --- src/fpm/toml.f90 | 66 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 65 insertions(+), 1 deletion(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index d0be9743b5..5359edf4ea 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -23,7 +23,7 @@ module fpm_toml public :: read_package_file, toml_table, toml_array, toml_key, toml_stat, & get_value, set_value, get_list, new_table, add_table, add_array, len, & - toml_error, toml_serialize, toml_load, check_keys, set_list + toml_error, toml_serialize, toml_load, check_keys, set_list, set_string !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON type, abstract, public :: serializable_t @@ -51,6 +51,11 @@ module fpm_toml end type serializable_t + interface set_string + module procedure set_character + module procedure set_string_type + end interface set_string + abstract interface @@ -352,6 +357,65 @@ subroutine set_list(table, key, list, error) end subroutine set_list + !> Function wrapper to set a character(len=:), allocatable variable to a toml table + subroutine set_character(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> List of keys to check. + character(len=*), intent(in) :: key + + !> The character variable + character(len=:), allocatable, intent(in) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + !> Check the key is not empty + if (len_trim(key)<=0) then + call fatal_error(error, 'key is empty setting character string to TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + if (allocated(var)) then + call set_value(table, key, var, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot set character key <'//key//'> in TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + endif + + end subroutine set_character + + !> Function wrapper to set a character(len=:), allocatable variable to a toml table + subroutine set_string_type(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> List of keys to check. + character(len=*), intent(in) :: key + + !> The character variable + type(string_t), intent(in) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + call set_character(table, key, var%s, error, whereAt) + + end subroutine set_string_type !> Check if table contains only keys that are part of the list. If a key is !> found that is not part of the list, an error is allocated. From 4c02c162c2163a9d966a24c71d20803849b6bac5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 18:36:18 +0200 Subject: [PATCH 26/80] `package_t`: implement serialization --- src/fpm_model.f90 | 129 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 121 insertions(+), 8 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index ee8692f5b6..0ebe907ff0 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -39,12 +39,13 @@ module fpm_model use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t use fpm_strings, only: string_t, str, len_trim, upper, operator(==) -use fpm_toml, only: serializable_t, toml_table, toml_stat, set_value, set_list, get_value, get_list +use fpm_toml, only: serializable_t, toml_table, toml_stat, set_value, set_list, get_value, & + & get_list, add_table, toml_key, add_array, set_string use fpm_error, only: error_t, fatal_error implicit none private -public :: fpm_model_t, srcfile_t, show_model, fortran_features_t +public :: fpm_model_t, srcfile_t, show_model, fortran_features_t, package_t public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & @@ -160,7 +161,7 @@ module fpm_model character(:), allocatable :: version !> Module naming conventions - logical :: enforce_module_names + logical :: enforce_module_names = .false. !> Prefix for all module names type(string_t) :: module_prefix @@ -662,8 +663,6 @@ subroutine fft_load_from_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: flag - integer :: ierr call get_value(table, "implicit-typing", self%implicit_typing, stat=ierr) @@ -736,7 +735,64 @@ subroutine package_dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call fatal_error(error,' not yet implemented ' ) + integer :: ierr, ii + type(toml_table), pointer :: ptr,this_source + character(16) :: src_name + + call set_string(table, "name", self%name, error, 'package_t') + if (allocated(error)) return + + call set_string(table, "version", self%version, error, 'package_t') + if (allocated(error)) return + + call set_value(table, "module-naming", self%enforce_module_names, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot set module-naming in TOML table') + return + end if + + call set_string(table, "module-prefix", self%module_prefix, error, 'package_t') + if (allocated(error)) return + + call set_list(table, "macros", self%macros, error) + if (allocated(error)) return + + !> Create a fortran table + call add_table(table, "fortran", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot set fortran table in TOML table') + return + end if + call self%features%dump_to_toml(ptr, error) + if (allocated(error)) return + + !> Create a sources table + if (allocated(self%sources)) then + + call add_table(table, "sources", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot set sources table in TOML table') + return + end if + + do ii = 1, size(self%sources) + + write(src_name,1) ii + call add_table(ptr, trim(src_name), this_source) + + if (.not. associated(this_source)) then + call fatal_error(error, "package_t cannot create entry for source "//trim(src_name)) + return + end if + + call self%sources(ii)%dump_to_toml(this_source,error) + if (allocated(error)) return + + end do + + end if + + 1 format('src_',i0) end subroutine package_dump_to_toml @@ -752,9 +808,66 @@ subroutine package_load_from_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: flag + integer :: ierr,ii,jj + type(toml_key), allocatable :: keys(:),src_keys(:) + type(toml_table), pointer :: ptr_sources,ptr,ptr_fortran + type(error_t), allocatable :: new_error + + call get_value(table, "name", self%name) + call get_value(table, "version", self%version) + + call get_value(table, "module-naming", self%enforce_module_names, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot get module-naming from TOML table') + return + end if + + ! Return unallocated value if not present + call get_value(table, "module-prefix", self%module_prefix%s) + + call get_list(table, "macros", self%macros, error) + if (allocated(error)) return + + ! Sources + call table%get_keys(keys) + + find_others: do ii = 1, size(keys) + select case (keys(ii)%key) + case ("fortran") + + call get_value(table, keys(ii), ptr_fortran) + if (.not.associated(ptr_fortran)) then + call fatal_error(error,'package_t: error retrieving fortran table from TOML table') + return + end if + + call self%features%load_from_toml(ptr_fortran,error) + if (allocated(error)) return + + case ("sources") + + call get_value(table, keys(ii), ptr_sources) + if (.not.associated(ptr_sources)) then + call fatal_error(error,'package_t: error retrieving sources table from TOML table') + return + end if + + !> Read all dependencies + call ptr_sources%get_keys(src_keys) + allocate(self%sources(size(src_keys))) + + do jj = 1, size(src_keys) + call get_value(ptr_sources, src_keys(jj), ptr) + call self%sources(jj)%load_from_toml(ptr, error) + if (allocated(error)) return + end do + + case default + cycle find_others + end select + end do find_others - call fatal_error(error, ' not yet implemented ') + call self%dump('tmp_pkg.toml',new_error) end subroutine package_load_from_toml From df02a551b13e39e788fa76dd9c6cda313cddd43a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 18:36:27 +0200 Subject: [PATCH 27/80] `package_t`: test serialization --- test/fpm_test/test_toml.f90 | 92 ++++++++++++++++++++++++++++++++++++- 1 file changed, 90 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 317ed906ab..82e3cdcff8 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -2,13 +2,14 @@ module test_toml use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml + use tomlf_constants, only: tf_i8 use fpm_git use fpm_dependency, only: dependency_node_t, destroy_dependency_node, dependency_tree_t, & & new_dependency_node, new_dependency_tree, resize use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split - use fpm_model, only: fortran_features_t + use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE implicit none private @@ -34,7 +35,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & - & new_unittest("serialize-fortran-features", fft_roundtrip)] + & new_unittest("serialize-fortran-features", fft_roundtrip), & + & new_unittest("serialize-package", package_roundtrip)] end subroutine collect_toml @@ -457,4 +459,90 @@ subroutine fft_roundtrip(error) end subroutine fft_roundtrip + !> Test serialization/deserialization of a package_t structure + subroutine package_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: pkg + integer :: ierr + + call pkg%dump('pkg.toml',error) + + !> Default object + call pkg%test_serialization('package_t: default object',error) + if (allocated(error)) return + + !> Create a dummy package + pkg%name = "orderpack" + pkg%version = "0.1.0" + pkg%enforce_module_names = .false. + pkg%module_prefix = string_t("") + pkg%features%source_form = "free" + + if (allocated(pkg%sources)) deallocate(pkg%sources) + allocate(pkg%sources(4)) + + pkg%sources(1)%file_name = "build/dependencies/orderpack/src/M_valnth.f90" + pkg%sources(1)%digest = 2662523002405134329_tf_i8 + pkg%sources(1)%unit_scope = FPM_SCOPE_LIB + pkg%sources(1)%unit_type = FPM_UNIT_MODULE + pkg%sources(1)%modules_provided = [string_t("m_valnth")] + deallocate(pkg%sources(1)%parent_modules, stat=ierr) + deallocate(pkg%sources(1)%modules_used, stat=ierr) + deallocate(pkg%sources(1)%include_dependencies, stat=ierr) + deallocate(pkg%sources(1)%link_libraries, stat=ierr) + + pkg%sources(2)%file_name = "build/dependencies/orderpack/src/M_mrgrnk.f90" + pkg%sources(2)%digest = 7985690966656622651_tf_i8 + pkg%sources(2)%unit_scope = FPM_SCOPE_LIB + pkg%sources(2)%unit_type = FPM_UNIT_MODULE + pkg%sources(2)%modules_provided = [string_t("m_mrgrnk")] + pkg%sources(2)%link_libraries = [string_t("netcdf"),string_t("hdf-5")] + deallocate(pkg%sources(2)%parent_modules, stat=ierr) + deallocate(pkg%sources(2)%modules_used, stat=ierr) + deallocate(pkg%sources(2)%include_dependencies, stat=ierr) + deallocate(pkg%sources(2)%link_libraries, stat=ierr) + + pkg%sources(3)%file_name = "build/dependencies/orderpack/src/M_median.f90" + pkg%sources(3)%digest = 7985690966656622651_tf_i8 + pkg%sources(3)%unit_scope = FPM_SCOPE_LIB + pkg%sources(3)%unit_type = FPM_UNIT_MODULE + pkg%sources(3)%modules_provided = [string_t("m_median")] + deallocate(pkg%sources(3)%parent_modules, stat=ierr) + deallocate(pkg%sources(3)%modules_used, stat=ierr) + deallocate(pkg%sources(3)%include_dependencies, stat=ierr) + deallocate(pkg%sources(3)%link_libraries, stat=ierr) + + pkg%sources(4)%file_name = "build/dependencies/orderpack/src/M_unista.f90" + pkg%sources(4)%digest = -7512253540457404792_tf_i8 + pkg%sources(4)%unit_scope = FPM_SCOPE_LIB + pkg%sources(4)%unit_type = FPM_UNIT_MODULE + pkg%sources(4)%modules_provided = [string_t("m_unista")] + pkg%sources(4)%modules_used = [string_t("m_uniinv")] + deallocate(pkg%sources(4)%parent_modules, stat=ierr) + deallocate(pkg%sources(4)%include_dependencies, stat=ierr) + deallocate(pkg%sources(4)%link_libraries, stat=ierr) + + !> Package mock + call pkg%test_serialization('package_t: orderpack',error) + if (allocated(error)) return + + !> Remove some entries + pkg%sources(1)%file_name = "" + pkg%sources(3)%digest = 0 + pkg%sources = pkg%sources(1:3) + call pkg%test_serialization('package_t: orderpack (reduced)',error) + if (allocated(error)) return + + !> Remove all sources + deallocate(pkg%sources,stat=ierr) + call pkg%test_serialization('package_t: no sources',error) + if (allocated(error)) return + + end subroutine package_roundtrip + + + end module test_toml From 3db7bb91b3fb41ca24123e5913e5c691f554a267 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 18:57:20 +0200 Subject: [PATCH 28/80] `archiver_t`: make `serializable_t` and implement test --- src/fpm_compiler.F90 | 129 +++++++++++++++++++++++++++++++++--- test/fpm_test/test_toml.f90 | 30 ++++++++- 2 files changed, 145 insertions(+), 14 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 0b70d3ca2f..d2d4b0e4aa 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -42,7 +42,8 @@ module fpm_compiler & getline, run use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str use fpm_manifest, only : package_config_t -use fpm_error, only: error_t +use fpm_error, only: error_t, fatal_error +use fpm_toml, only: serializable_t, toml_table, set_string, set_value, toml_stat, get_value implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros public :: debug @@ -112,7 +113,7 @@ module fpm_compiler !> Definition of archiver object -type :: archiver_t +type, extends(serializable_t) :: archiver_t !> Path to archiver character(len=:), allocatable :: ar !> Use response files to pass arguments @@ -124,6 +125,12 @@ module fpm_compiler contains !> Create static archive procedure :: make_archive + + !> Serialization interface + procedure :: serializable_is_same => ar_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type archiver_t @@ -211,7 +218,7 @@ module fpm_compiler flag_cray_implicit_typing = " -el", & flag_cray_fixed_form = " -ffixed", & flag_cray_free_form = " -ffree" - + contains @@ -440,7 +447,7 @@ pure subroutine set_cpp_preprocessor_flags(id, flags) end subroutine set_cpp_preprocessor_flags -!> This function will parse and read the macros list and +!> This function will parse and read the macros list and !> return them as defined flags. function get_macros(id, macros_list, version) result(macros) integer(compiler_enum), intent(in) :: id @@ -450,7 +457,7 @@ function get_macros(id, macros_list, version) result(macros) character(len=:), allocatable :: macros character(len=:), allocatable :: macro_definition_symbol character(:), allocatable :: valued_macros(:) - + integer :: i @@ -473,10 +480,10 @@ function get_macros(id, macros_list, version) result(macros) end if do i = 1, size(macros_list) - + !> Split the macro name and value. call split(macros_list(i)%s, valued_macros, delimiters="=") - + if (size(valued_macros) > 1) then !> Check if the value of macro starts with '{' character. if (str_begins_with_str(trim(valued_macros(size(valued_macros))), "{")) then @@ -486,15 +493,15 @@ function get_macros(id, macros_list, version) result(macros) !> Check if the string contains "version" as substring. if (index(valued_macros(size(valued_macros)), "version") /= 0) then - + !> These conditions are placed in order to ensure proper spacing between the macros. macros = macros//macro_definition_symbol//trim(valued_macros(1))//'='//version cycle end if end if - end if + end if end if - + macros = macros//macro_definition_symbol//macros_list(i)%s end do @@ -919,7 +926,7 @@ subroutine new_compiler(self, fc, cc, cxx, echo, verbose) logical, intent(in) :: verbose self%id = get_compiler_id(fc) - + self%echo = echo self%verbose = verbose self%fc = fc @@ -1141,5 +1148,105 @@ pure function debug_archiver(self) result(repr) repr = 'ar="'//self%ar//'"' end function debug_archiver +!> Check that two source files are equal +logical function ar_is_same(this,that) + class(archiver_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + ar_is_same = .false. + + select type (other=>that) + type is (archiver_t) + + if (.not.(this%ar==other%ar)) return + if (.not.(this%use_response_file.eqv.other%use_response_file)) return + if (.not.(this%echo.eqv.other%echo)) return + if (.not.(this%verbose.eqv.other%verbose)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + ar_is_same = .true. + +end function ar_is_same + +!> Dump dependency to toml table +subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(archiver_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + !> Path to archiver + call set_string(table, "ar", self%ar, error, 'archiver_t') + if (allocated(error)) return + + call set_value(table, "use-response-file", self%use_response_file, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error dumping use_response_file') + return + end if + + call set_value(table, "echo", self%echo, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error dumping echo') + return + end if + + call set_value(table, "verbose", self%verbose, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error dumping verbose') + return + end if + +end subroutine dump_to_toml + +!> Read dependency from toml table (no checks made at this stage) +subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(archiver_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + call get_value(table, "ar", self%ar) + + call get_value(table, "use-response-file", self%use_response_file, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error getting use_response_file from TOML') + return + end if + + call get_value(table, "echo", self%echo, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error getting echo from TOML') + return + end if + + call get_value(table, "verbose", self%verbose, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error getting verbose from TOML') + return + end if + +end subroutine load_from_toml + + end module fpm_compiler diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 82e3cdcff8..10dee51754 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -10,6 +10,7 @@ module test_toml use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE + use fpm_compiler, only: archiver_t implicit none private @@ -36,7 +37,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & - & new_unittest("serialize-package", package_roundtrip)] + & new_unittest("serialize-package", package_roundtrip), & + & new_unittest("serialize-archiver", ar_roundtrip)] end subroutine collect_toml @@ -468,8 +470,6 @@ subroutine package_roundtrip(error) type(package_t) :: pkg integer :: ierr - call pkg%dump('pkg.toml',error) - !> Default object call pkg%test_serialization('package_t: default object',error) if (allocated(error)) return @@ -543,6 +543,30 @@ subroutine package_roundtrip(error) end subroutine package_roundtrip + !> Test serialization/deserialization of an archiver_t structure + subroutine ar_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(archiver_t) :: ar + integer :: ierr + + call ar%dump('ar.toml',error) + + !> Default object + call ar%test_serialization('archiver_t: default object',error) + if (allocated(error)) return + + !> change a few items + ar%ar = "ar" + ar%echo = .true. + ar%use_response_file = .false. + + call ar%test_serialization('archiver_t: ar',error) + + end subroutine ar_roundtrip + end module test_toml From 2f1e8cf11937b48e45ef27e32301613810774a7b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 19:08:44 +0200 Subject: [PATCH 29/80] `compiler_t`: make `serializable_t` and implement test --- src/fpm_compiler.F90 | 117 +++++++++++++++++++++++++++++++++++- test/fpm_test/test_toml.f90 | 31 ++++++++-- 2 files changed, 142 insertions(+), 6 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index d2d4b0e4aa..b8e3010777 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -75,7 +75,7 @@ module fpm_compiler !> Definition of compiler object -type :: compiler_t +type, extends(serializable_t) :: compiler_t !> Identifier of the compiler integer(compiler_enum) :: id = id_unknown !> Path to the Fortran compiler @@ -109,6 +109,12 @@ module fpm_compiler procedure :: is_unknown !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries + + !> Serialization interface + procedure :: serializable_is_same => compiler_is_same + procedure :: dump_to_toml => compiler_dump + procedure :: load_from_toml => compiler_load + end type compiler_t @@ -1148,7 +1154,7 @@ pure function debug_archiver(self) result(repr) repr = 'ar="'//self%ar//'"' end function debug_archiver -!> Check that two source files are equal +!> Check that two archiver_t objects are equal logical function ar_is_same(this,that) class(archiver_t), intent(in) :: this class(serializable_t), intent(in) :: that @@ -1247,6 +1253,113 @@ subroutine load_from_toml(self, table, error) end subroutine load_from_toml +!> Check that two compiler_t objects are equal +logical function compiler_is_same(this,that) + class(compiler_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + compiler_is_same = .false. + + select type (other=>that) + type is (compiler_t) + + if (.not.(this%id==other%id)) return + if (.not.(this%fc==other%fc)) return + if (.not.(this%cc==other%cc)) return + if (.not.(this%cxx==other%cxx)) return + if (.not.(this%echo.eqv.other%echo)) return + if (.not.(this%verbose.eqv.other%verbose)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + compiler_is_same = .true. + +end function compiler_is_same + +!> Dump dependency to toml table +subroutine compiler_dump(self, table, error) + + !> Instance of the serializable object + class(compiler_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + call set_value(table, "id", self%id, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'compiler_t: error dumping id') + return + end if + + call set_string(table, "fc", self%fc, error, 'compiler_t') + if (allocated(error)) return + call set_string(table, "cc", self%cc, error, 'compiler_t') + if (allocated(error)) return + call set_string(table, "cxx", self%cxx, error, 'compiler_t') + if (allocated(error)) return + + call set_value(table, "echo", self%echo, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error dumping echo') + return + end if + + call set_value(table, "verbose", self%verbose, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'archiver_t: error dumping verbose') + return + end if + +end subroutine compiler_dump + +!> Read dependency from toml table (no checks made at this stage) +subroutine compiler_load(self, table, error) + + !> Instance of the serializable object + class(compiler_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr + + call get_value(table, "id", self%id, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'compiler_t: error getting id from TOML') + return + end if + + call get_value(table, "fc", self%fc) + call get_value(table, "cc", self%cc) + call get_value(table, "cxx", self%cxx) + + call get_value(table, "echo", self%echo, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'compiler_t: error getting echo from TOML') + return + end if + + call get_value(table, "verbose", self%verbose, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'compiler_t: error getting verbose from TOML') + return + end if + +end subroutine compiler_load + + end module fpm_compiler diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 10dee51754..800cc0433c 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -10,7 +10,7 @@ module test_toml use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE - use fpm_compiler, only: archiver_t + use fpm_compiler, only: archiver_t, compiler_t, id_gcc implicit none private @@ -38,7 +38,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-package", package_roundtrip), & - & new_unittest("serialize-archiver", ar_roundtrip)] + & new_unittest("serialize-archiver", ar_roundtrip), & + & new_unittest("serialize-compiler", compiler_roundtrip)] end subroutine collect_toml @@ -552,8 +553,6 @@ subroutine ar_roundtrip(error) type(archiver_t) :: ar integer :: ierr - call ar%dump('ar.toml',error) - !> Default object call ar%test_serialization('archiver_t: default object',error) if (allocated(error)) return @@ -568,5 +567,29 @@ subroutine ar_roundtrip(error) end subroutine ar_roundtrip + !> Test serialization/deserialization of a compiler_t structure + subroutine compiler_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(compiler_t) :: compiler + + !> Default object + call compiler%test_serialization('compiler_t: default object',error) + if (allocated(error)) return + + !> change a few items + compiler%id = id_gcc + compiler%fc = "gfortran -ffree-line-length-none -fdefault-real-8 -O3" + compiler%cc = "" + compiler%cxx = "g++ -O3 -std=c++11" + compiler%echo = .false. + + call compiler%dump('compiler.toml',error) + + call compiler%test_serialization('compiler_t: gcc',error) + + end subroutine compiler_roundtrip end module test_toml From 8d211f133df45546db7a9965e338d5e511a19cfe Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 19:19:02 +0200 Subject: [PATCH 30/80] `fpm_model_t`: make `serializable_t`, implement comparison operator --- src/fpm_model.f90 | 91 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 88 insertions(+), 3 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 0ebe907ff0..3a2204d025 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -181,7 +181,7 @@ module fpm_model !> Type describing everything required to build !> the root package and its dependencies. -type :: fpm_model_t +type, extends(serializable_t) :: fpm_model_t !> Name of root package character(:), allocatable :: package_name @@ -231,6 +231,13 @@ module fpm_model !> Prefix for all module names type(string_t) :: module_prefix + contains + + !> Serialization interface + procedure :: serializable_is_same => model_is_same + procedure :: dump_to_toml => model_dump_to_toml + procedure :: load_from_toml => model_load_from_toml + end type fpm_model_t contains @@ -867,9 +874,87 @@ subroutine package_load_from_toml(self, table, error) end select end do find_others - call self%dump('tmp_pkg.toml',new_error) - end subroutine package_load_from_toml +!> Check that two model objects are equal +logical function model_is_same(this,that) + class(fpm_model_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + type(fpm_model_t), pointer :: other + + integer :: ii + + model_is_same = .false. + + select type (other=>that) + type is (fpm_model_t) + + if (.not.(this%package_name==other%package_name)) return + if (.not.(allocated(this%packages).eqv.allocated(other%packages))) return + if (allocated(this%packages)) then + if (.not.(size(this%packages)==size(other%packages))) return + do ii = 1, size(this%packages) + if (.not.(this%packages(ii)==other%packages(ii))) return + end do + end if + + if (.not.(this%compiler==other%compiler)) return + if (.not.(this%archiver==other%archiver)) return + if (.not.(this%fortran_compile_flags==other%fortran_compile_flags)) return + if (.not.(this%c_compile_flags==other%c_compile_flags)) return + if (.not.(this%cxx_compile_flags==other%cxx_compile_flags)) return + if (.not.(this%link_flags==other%link_flags)) return + if (.not.(this%build_prefix==other%build_prefix)) return + if (.not.(this%include_dirs==other%include_dirs)) return + if (.not.(this%link_libraries==other%link_libraries)) return + if (.not.(this%external_modules==other%external_modules)) return + if (.not.(this%deps==other%deps)) return + if (.not.(this%include_tests.eqv.other%include_tests)) return + if (.not.(this%enforce_module_names.eqv.other%enforce_module_names)) return + if (.not.(this%module_prefix==other%module_prefix)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + model_is_same = .true. + +end function model_is_same + +!> Dump dependency to toml table +subroutine model_dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(fpm_model_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call fatal_error(error,' model_t: dump not implemented ') + +end subroutine model_dump_to_toml + +!> Read dependency from toml table (no checks made at this stage) +subroutine model_load_from_toml(self, table, error) + + !> Instance of the serializable object + class(fpm_model_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call fatal_error(error,' model_t: load not implemented ') + +end subroutine model_load_from_toml + end module fpm_model From f46dccfa6604448b25f385f80127d808cfaccbfe Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 19:46:31 +0200 Subject: [PATCH 31/80] `fpm_model_t`: implement serialization --- src/fpm_model.f90 | 196 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 194 insertions(+), 2 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 3a2204d025..f0593b16b1 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -937,7 +937,103 @@ subroutine model_dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call fatal_error(error,' model_t: dump not implemented ') + integer :: ierr, ii + type(toml_table), pointer :: ptr,ptr_pkg + character(27) :: unnamed + + call set_string(table, "package-name", self%package_name, error, 'fpm_model_t') + if (allocated(error)) return + + call add_table(table, "compiler", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot set compiler table') + return + end if + call self%compiler%dump_to_toml(ptr, error) + if (allocated(error)) return + + call add_table(table, "archiver", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'package_t: cannot set archiver table') + return + end if + call self%archiver%dump_to_toml(ptr, error) + if (allocated(error)) return + + call set_string(table, "fortran-flags", self%fortran_compile_flags, error, 'fpm_model_t') + if (allocated(error)) return + call set_string(table, "c-flags", self%c_compile_flags, error, 'fpm_model_t') + if (allocated(error)) return + call set_string(table, "cxx-flags", self%cxx_compile_flags, error, 'fpm_model_t') + if (allocated(error)) return + call set_string(table, "link-flags", self%link_flags, error, 'fpm_model_t') + if (allocated(error)) return + call set_string(table, "build-prefix", self%build_prefix, error, 'fpm_model_t') + if (allocated(error)) return + call set_list(table, "include-dirs", self%include_dirs, error) + if (allocated(error)) return + call set_list(table, "link-libraries", self%link_libraries, error) + if (allocated(error)) return + call set_list(table, "external-modules", self%external_modules, error) + if (allocated(error)) return + + call set_value(table, "include-tests", self%include_tests, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fpm_model_t: cannot set include-tests in TOML table') + return + end if + + call set_value(table, "module-naming", self%enforce_module_names, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fpm_model_t: cannot set module-naming in TOML table') + return + end if + call set_string(table, "module-prefix", self%module_prefix, error, 'fpm_model_t') + if (allocated(error)) return + + call add_table(table, "deps", ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fpm_model_t: cannot set dependencies table') + return + end if + call self%deps%dump_to_toml(ptr, error) + if (allocated(error)) return + + !> Array of packages (including the root package) + if (allocated(self%packages)) then + + ! Create packages table + call add_table(table, "packages", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, "fpm_model_t cannot create dependency table ") + return + end if + + do ii = 1, size(self%packages) + + associate (pkg => self%packages(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) ii + call add_table(ptr_pkg, trim(unnamed), ptr) + else + call add_table(ptr_pkg, pkg%name, ptr) + end if + if (.not. associated(ptr)) then + call fatal_error(error, "fpm_model_t cannot create entry for package "//pkg%name) + return + end if + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + 1 format('UNNAMED_PACKAGE_',i0) end subroutine model_dump_to_toml @@ -953,7 +1049,103 @@ subroutine model_load_from_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call fatal_error(error,' model_t: load not implemented ') + type(toml_key), allocatable :: keys(:),pkg_keys(:) + integer :: ierr, ii, jj + type(toml_table), pointer :: ptr,ptr_pkg + character(27) :: unnamed + + call table%get_keys(keys) + + call get_value(table, "package-name", self%package_name) + call get_value(table, "fortran-flags", self%fortran_compile_flags) + call get_value(table, "c-flags", self%c_compile_flags) + call get_value(table, "cxx-flags", self%cxx_compile_flags) + call get_value(table, "link-flags", self%link_flags) + call get_value(table, "build-prefix", self%build_prefix) + + if (allocated(self%packages)) deallocate(self%packages) + sub_deps: do ii = 1, size(keys) + + select case (keys(ii)%key) + case ("compiler") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,'fpm_model_t: error retrieving compiler table') + return + end if + + call self%compiler%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("archiver") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,'fpm_model_t: error retrieving archiver table') + return + end if + + call self%archiver%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("deps") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,'fpm_model_t: error retrieving dependency tree table') + return + end if + + call self%deps%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("packages") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,'fpm_model_t: error retrieving packages table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%packages(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%packages(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + + end do + + + case default + cycle sub_deps + end select + + end do sub_deps + + call get_list(table, "include-dirs", self%include_dirs, error) + if (allocated(error)) return + call get_list(table, "link-libraries", self%link_libraries, error) + if (allocated(error)) return + call get_list(table, "external-modules", self%external_modules, error) + if (allocated(error)) return + + call get_value(table, "include-tests", self%include_tests, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fpm_model_t: cannot read include-tests in TOML table') + return + end if + + call get_value(table, "module-naming", self%enforce_module_names, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'fpm_model_t: cannot set module-naming in TOML table') + return + end if + call get_value(table, "module-prefix", self%module_prefix%s) end subroutine model_load_from_toml From 152faa2ccff2c403abe442d1f7db7d32203761dd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 12 Apr 2023 20:20:38 +0200 Subject: [PATCH 32/80] `fpm_model_t`: implement test (to be reduced) --- test/fpm_test/test_toml.f90 | 1261 ++++++++++++++++++++++++++++++++++- 1 file changed, 1259 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 800cc0433c..d7afad507a 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -9,7 +9,7 @@ module test_toml use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split - use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE + use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t use fpm_compiler, only: archiver_t, compiler_t, id_gcc implicit none @@ -39,7 +39,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-package", package_roundtrip), & & new_unittest("serialize-archiver", ar_roundtrip), & - & new_unittest("serialize-compiler", compiler_roundtrip)] + & new_unittest("serialize-compiler", compiler_roundtrip), & + & new_unittest("serialize-model", fpm_model_roundtrip)] end subroutine collect_toml @@ -592,4 +593,1260 @@ subroutine compiler_roundtrip(error) end subroutine compiler_roundtrip + !> Get a simplified TOML representation of the fpm v0.8.1 model + subroutine fpm_081_table(table) + + !> TOML representation of the fpm v0.8.1 model + type(toml_table), allocatable, intent(out) :: table + + !> simplified TOML representation of the fpm v0.8.1 model + character, parameter :: NL = new_line('a') + character(len=:), allocatable :: fpm + + integer :: iunit + + allocate(character(len=0) :: fpm) + fpm = fpm//NL//'package-name = "fpm"' + fpm = fpm//NL//'fortran-flags = " -Wall -Wextra -fPIC -fmax-errors=1 -g "' + fpm = fpm//NL//'c-flags = ""' + fpm = fpm//NL//'cxx-flags = ""' + fpm = fpm//NL//'link-flags = ""' + fpm = fpm//NL//'build-prefix = "build/gfortran"' + fpm = fpm//NL//'include-dirs = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'external-modules = [ ]' + fpm = fpm//NL//'include-tests = false' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[compiler]' + fpm = fpm//NL//'id = 1' + fpm = fpm//NL//'fc = "gfortran"' + fpm = fpm//NL//'cc = "gcc"' + fpm = fpm//NL//'cxx = "g++"' + fpm = fpm//NL//'echo = false' + fpm = fpm//NL//'verbose = false' + fpm = fpm//NL//'[archiver]' + fpm = fpm//NL//'ar = "ar -rs "' + fpm = fpm//NL//'use-response-file = false' + fpm = fpm//NL//'echo = false' + fpm = fpm//NL//'verbose = false' + fpm = fpm//NL//'[deps]' + fpm = fpm//NL//'unit = 6' + fpm = fpm//NL//'verbosity = 1' + fpm = fpm//NL//'dep-dir = "build/dependencies"' + fpm = fpm//NL//'cache = "build/cache.toml"' + fpm = fpm//NL//'ndep = 4' + fpm = fpm//NL//'[deps.dependencies]' + fpm = fpm//NL//'[deps.dependencies.fpm]' + fpm = fpm//NL//'name = "fpm"' + fpm = fpm//NL//'path = "."' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'proj-dir = "./."' + fpm = fpm//NL//'done = true' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.toml-f]' + fpm = fpm//NL//'name = "toml-f"' + fpm = fpm//NL//'version = "0.4.0"' + fpm = fpm//NL//'proj-dir = "build/dependencies/toml-f"' + fpm = fpm//NL//'revision = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f"' + fpm = fpm//NL//'done = true' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = true' + fpm = fpm//NL//'[deps.dependencies.toml-f.git]' + fpm = fpm//NL//'descriptor = "revision"' + fpm = fpm//NL//'url = "https://github.com/toml-f/toml-f"' + fpm = fpm//NL//'object = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f"' + fpm = fpm//NL//'[deps.dependencies.M_CLI2]' + fpm = fpm//NL//'name = "M_CLI2"' + fpm = fpm//NL//'version = "1.0.0"' + fpm = fpm//NL//'proj-dir = "build/dependencies/M_CLI2"' + fpm = fpm//NL//'revision = "7264878cdb1baff7323cc48596d829ccfe7751b8"' + fpm = fpm//NL//'done = true' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = true' + fpm = fpm//NL//'[deps.dependencies.M_CLI2.git]' + fpm = fpm//NL//'descriptor = "revision"' + fpm = fpm//NL//'url = "https://github.com/urbanjost/M_CLI2.git"' + fpm = fpm//NL//'object = "7264878cdb1baff7323cc48596d829ccfe7751b8"' + fpm = fpm//NL//'[deps.dependencies.jonquil]' + fpm = fpm//NL//'name = "jonquil"' + fpm = fpm//NL//'version = "0.2.0"' + fpm = fpm//NL//'proj-dir = "build/dependencies/jonquil"' + fpm = fpm//NL//'revision = "05d30818bb12fb877226ce284b9a3a41b971a889"' + fpm = fpm//NL//'done = true' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = true' + fpm = fpm//NL//'[deps.dependencies.jonquil.git]' + fpm = fpm//NL//'descriptor = "revision"' + fpm = fpm//NL//'url = "https://github.com/toml-f/jonquil"' + fpm = fpm//NL//'object = "05d30818bb12fb877226ce284b9a3a41b971a889"' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_5]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_6]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_7]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_8]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_9]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_10]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_11]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_12]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_13]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_14]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_15]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_16]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_17]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_18]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_19]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_20]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_21]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_22]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_23]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_24]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_25]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[packages]' + fpm = fpm//NL//'[packages.fpm]' + fpm = fpm//NL//'name = "fpm"' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[packages.fpm.fortran]' + fpm = fpm//NL//'implicit-typing = false' + fpm = fpm//NL//'implicit-external = false' + fpm = fpm//NL//'source-form = "free"' + fpm = fpm//NL//'[packages.fpm.sources]' + fpm = fpm//NL//'[packages.fpm.sources.src_1]' + fpm = fpm//NL//'file-name = "././src/fpm.f90"' + fpm = fpm//NL//'digest = 4322290725857190613' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_strings", "fpm_backend", "fpm_compiler", "fpm_error" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_2]' + fpm = fpm//NL//'file-name = "././src/fpm_backend.F90"' + fpm = fpm//NL//'digest = -3210121688944515946' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_backend"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_backend_output" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_3]' + fpm = fpm//NL//'file-name = "././src/fpm_environment.f90"' + fpm = fpm//NL//'digest = 2235607720245152632' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_environment"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "fpm_error"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_4]' + fpm = fpm//NL//'file-name = "././src/fpm_model.f90"' + fpm = fpm//NL//'digest = -6774177234665080583' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_model"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_compiler", "fpm_dependency" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_5]' + fpm = fpm//NL//'file-name = "././src/filesystem_utilities.c"' + fpm = fpm//NL//'digest = 4957633104775755438' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_6]' + fpm = fpm//NL//'file-name = "././src/fpm_filesystem.F90"' + fpm = fpm//NL//'digest = 1871084827152368652' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_filesystem"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_7]' + fpm = fpm//NL//'file-name = "././src/fpm_strings.f90"' + fpm = fpm//NL//'digest = 7038915013685504829' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_strings"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_8]' + fpm = fpm//NL//'file-name = "././src/fpm_settings.f90"' + fpm = fpm//NL//'digest = -885425387141891996' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_settings"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment", "fpm_error" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_9]' + fpm = fpm//NL//'file-name = "././src/fpm_os.c"' + fpm = fpm//NL//'digest = -4523865409175594663' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_10]' + fpm = fpm//NL//'file-name = "././src/fpm_backend_console.f90"' + fpm = fpm//NL//'digest = 1732983699585955966' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_backend_console"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_11]' + fpm = fpm//NL//'file-name = "././src/fpm_source_parsing.f90"' + fpm = fpm//NL//'digest = 6098986130375861226' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_source_parsing"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_model", "fpm_filesystem" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_12]' + fpm = fpm//NL//'file-name = "././src/fpm_os.F90"' + fpm = fpm//NL//'digest = -4743856136050054640' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_os"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment", "fpm_error" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_13]' + fpm = fpm//NL//'file-name = "././src/fpm_compiler.F90"' + fpm = fpm//NL//'digest = -2442073797366752057' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_compiler"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_filesystem", "fpm_strings" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_14]' + fpm = fpm//NL//'file-name = "././src/fpm_command_line.f90"' + fpm = fpm//NL//'digest = 7180707928326338392' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_command_line"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_environment", "m_cli2", "m_cli2", "fpm_strings" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_15]' + fpm = fpm//NL//'file-name = "././src/fpm_backend_output.f90"' + fpm = fpm//NL//'digest = 7154367044486334558' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_backend_output"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_targets", "fpm_backend_console" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_16]' + fpm = fpm//NL//'file-name = "././src/fpm_targets.f90"' + fpm = fpm//NL//'digest = -8234965779941208361' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_targets"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_model", "fpm_compiler", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_17]' + fpm = fpm//NL//'file-name = "././src/fpm_sources.f90"' + fpm = fpm//NL//'digest = 3391120653956350167' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_sources"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_model", "fpm_filesystem", "fpm_strings" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_18]' + fpm = fpm//NL//'file-name = "././src/ptycheck/iscygpty.c"' + fpm = fpm//NL//'digest = -4887164695298162637' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = "iscygpty.h"' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_19]' + fpm = fpm//NL//'file-name = "././src/ptycheck/isatty.c"' + fpm = fpm//NL//'digest = 6664536934601490990' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = "iscygpty.h"' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_20]' + fpm = fpm//NL//'file-name = "././src/ptycheck/iscygpty.h"' + fpm = fpm//NL//'digest = -3550201113101300999' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CHEADER"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_21]' + fpm = fpm//NL//'file-name = "././src/fpm/downloader.f90"' + fpm = fpm//NL//'digest = 620358568720613499' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_SUBPROGRAM"' + fpm = fpm//NL//'modules-provided = "fpm_downloader"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_versioning", "jonquil" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_22]' + fpm = fpm//NL//'file-name = "././src/fpm/error.f90"' + fpm = fpm//NL//'digest = 7324399436715753500' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_error"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "fpm_strings"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_23]' + fpm = fpm//NL//'file-name = "././src/fpm/toml.f90"' + fpm = fpm//NL//'digest = 2411620725015864401' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_toml"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "tomlf" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_24]' + fpm = fpm//NL//'file-name = "././src/fpm/installer.f90"' + fpm = fpm//NL//'digest = 581769321360482292' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_installer"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_error", "fpm_filesystem" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_25]' + fpm = fpm//NL//'file-name = "././src/fpm/versioning.f90"' + fpm = fpm//NL//'digest = -1370610786727991294' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_versioning"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "fpm_error"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_26]' + fpm = fpm//NL//'file-name = "././src/fpm/git.f90"' + fpm = fpm//NL//'digest = -7368368636549243157' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_git"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_27]' + fpm = fpm//NL//'file-name = "././src/fpm/dependency.f90"' + fpm = fpm//NL//'digest = -2836785909441977019' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_dependency"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_error", "fpm_filesystem"]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_28]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest.f90"' + fpm = fpm//NL//'digest = -1346850924839827718' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_manifest_build", "fpm_manifest_example" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_29]' + fpm = fpm//NL//'file-name = "././src/fpm/cmd/new.f90"' + fpm = fpm//NL//'digest = 697853208011446608' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_cmd_new"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_30]' + fpm = fpm//NL//'file-name = "././src/fpm/cmd/update.f90"' + fpm = fpm//NL//'digest = -8232305547308400988' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_cmd_update"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_manifest" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_31]' + fpm = fpm//NL//'file-name = "././src/fpm/cmd/install.f90"' + fpm = fpm//NL//'digest = -6707501025391219376' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_cmd_install"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm", "fpm_backend", "fpm_command_line" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_32]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/test.f90"' + fpm = fpm//NL//'digest = 1399197227023080626' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_test"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_33]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/profiles.f90"' + fpm = fpm//NL//'digest = -7975317648924650587' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_profile"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml", "fpm_strings", "fpm_filesystem" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_34]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/example.f90"' + fpm = fpm//NL//'digest = 2220193652669081694' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_example"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_35]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/executable.f90"' + fpm = fpm//NL//'digest = 2826537585451151940' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_executable"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_error", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_36]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/install.f90"' + fpm = fpm//NL//'digest = 6941308343630725905' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_install"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_37]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/package.f90"' + fpm = fpm//NL//'digest = 4046915203104200691' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_package"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_manifest_build", "fpm_manifest_dependency", ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_38]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/preprocess.f90"' + fpm = fpm//NL//'digest = 4463864760686846214' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_mainfest_preprocess"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_39]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/build.f90"' + fpm = fpm//NL//'digest = 7486174362460284832' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_build"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_40]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/dependency.f90"' + fpm = fpm//NL//'digest = -6006235286439662663' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_dependency"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_git", "fpm_versioning" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_41]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/library.f90"' + fpm = fpm//NL//'digest = -1698783511442136567' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_library"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_42]' + fpm = fpm//NL//'file-name = "././src/fpm/manifest/fortran.f90"' + fpm = fpm//NL//'digest = -6768952943164424742' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "fpm_manifest_fortran"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_43]' + fpm = fpm//NL//'file-name = "app/main.f90"' + fpm = fpm//NL//'exe-name = "fpm"' + fpm = fpm//NL//'digest = 7759460120440225004' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_APP"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_os" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_44]' + fpm = fpm//NL//'file-name = "test/help_test/help_test.f90"' + fpm = fpm//NL//'exe-name = "help-test"' + fpm = fpm//NL//'digest = -7601948172740854190' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_45]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_os.f90"' + fpm = fpm//NL//'digest = 718441623146001654' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_os"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_environment", "fpm_os" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_46]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_source_parsing.f90"' + fpm = fpm//NL//'digest = 5852386252678959798' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_SUBPROGRAM"' + fpm = fpm//NL//'modules-provided = "test_source_parsing"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_strings" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_47]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_settings.f90"' + fpm = fpm//NL//'digest = -3541669032396077479' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_settings"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_settings", "fpm_filesystem", "fpm_os" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_48]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_backend.f90"' + fpm = fpm//NL//'digest = 2723265999281936523' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_backend"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "test_module_dependencies", "fpm_backend" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_49]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_versioning.f90"' + fpm = fpm//NL//'digest = 7879213895027593947' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_versioning"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_versioning" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_50]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_manifest.f90"' + fpm = fpm//NL//'digest = -5417606542127631442' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_manifest"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "testsuite", "fpm_manifest" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_51]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_filesystem.f90"' + fpm = fpm//NL//'digest = -3128825714354096496' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_filesystem"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_52]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_installer.f90"' + fpm = fpm//NL//'digest = 6893981694820313345' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_installer"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_environment", "fpm_filesystem", "fpm_installer" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_53]' + fpm = fpm//NL//'file-name = "test/fpm_test/main.f90"' + fpm = fpm//NL//'exe-name = "fpm-test"' + fpm = fpm//NL//'digest = -6659997723519103741' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "test_toml", "test_manifest", "test_os" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_54]' + fpm = fpm//NL//'file-name = "test/fpm_test/testsuite.f90"' + fpm = fpm//NL//'digest = 4708439108904007602' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "testsuite"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "fpm_error"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_55]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_toml.f90"' + fpm = fpm//NL//'digest = -4238391920328466228' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_toml"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_toml", "tomlf_constants", "fpm_compiler" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_56]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_package_dependencies.f90"' + fpm = fpm//NL//'digest = 1143008373292682612' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_package_dependencies"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "testsuite", "fpm_versioning", "jonquil" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_57]' + fpm = fpm//NL//'file-name = "test/fpm_test/test_module_dependencies.f90"' + fpm = fpm//NL//'digest = -8398823885747598218' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "test_module_dependencies"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_targets", "fpm" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_58]' + fpm = fpm//NL//'file-name = "test/cli_test/cli_test.f90"' + fpm = fpm//NL//'exe-name = "cli-test"' + fpm = fpm//NL//'digest = 7502982943646619950' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm", "fpm_cmd_new" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.fpm.sources.src_59]' + fpm = fpm//NL//'file-name = "test/new_test/new_test.f90"' + fpm = fpm//NL//'exe-name = "new-test"' + fpm = fpm//NL//'digest = 4683353150944180202' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_strings", "fpm_environment" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f]' + fpm = fpm//NL//'name = "toml-f"' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[packages.toml-f.fortran]' + fpm = fpm//NL//'implicit-typing = false' + fpm = fpm//NL//'implicit-external = false' + fpm = fpm//NL//'source-form = "free"' + fpm = fpm//NL//'[packages.toml-f.sources]' + fpm = fpm//NL//'[packages.toml-f.sources.src_1]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf.f90"' + fpm = fpm//NL//'digest = -8299830903248890534' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build", "tomlf_datetime" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_2]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/constants.f90"' + fpm = fpm//NL//'digest = 7170350792708576173' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_constants"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_3]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/version.f90"' + fpm = fpm//NL//'digest = 7297460108185920032' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_version"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_4]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure.f90"' + fpm = fpm//NL//'digest = -5586939372904264461' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_structure_ordered_map" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_5]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/error.f90"' + fpm = fpm//NL//'digest = -6990387780017431402' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_error"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_constants"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_6]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/ser.f90"' + fpm = fpm//NL//'digest = 2173577414279434444' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_ser"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_7]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de.f90"' + fpm = fpm//NL//'digest = 6984491308379570724' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_8]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils.f90"' + fpm = fpm//NL//'digest = -1654455727593730955' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_utils"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_utils_io" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_9]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/datetime.f90"' + fpm = fpm//NL//'digest = 360194003049506468' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_datetime"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_constants"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_10]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/diagnostic.f90"' + fpm = fpm//NL//'digest = -6145654881147673446' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_diagnostic"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_terminal"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_11]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type.f90"' + fpm = fpm//NL//'digest = 7822704506185839449' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_type"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_12]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build.f90"' + fpm = fpm//NL//'digest = 6734874397655167084' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build_array", "tomlf_build_table" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_13]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/all.f90"' + fpm = fpm//NL//'digest = -3373616532185720889' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_all"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build", "tomlf_type", "tomlf_utils", "tomlf_version" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_14]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/terminal.f90"' + fpm = fpm//NL//'digest = 6124874315911091908' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_terminal"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_utils"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_15]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils/sort.f90"' + fpm = fpm//NL//'digest = -7275638313901306893' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_utils_sort"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_type_value"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_16]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils/io.f90"' + fpm = fpm//NL//'digest = -4559681945420894782' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_utils_io"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_constants"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_17]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/keyval.f90"' + fpm = fpm//NL//'digest = 7305553188003635285' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_type_keyval"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_18]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/table.f90"' + fpm = fpm//NL//'digest = -1731470661964884986' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_type_table"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_structure" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_19]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/array.f90"' + fpm = fpm//NL//'digest = 5202963073293705116' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_type_array"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_error", "tomlf_type_value", "tomlf_structure" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_20]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/value.f90"' + fpm = fpm//NL//'digest = 988208496786453415' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_type_value"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_21]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/context.f90"' + fpm = fpm//NL//'digest = -6236998766484611847' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de_context"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_terminal" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_22]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/lexer.f90"' + fpm = fpm//NL//'digest = -5703883624156149303' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de_lexer"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_error", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_23]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/token.f90"' + fpm = fpm//NL//'digest = -6068697997670165243' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de_token"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_24]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/parser.f90"' + fpm = fpm//NL//'digest = -3187016653233800622' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de_parser"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_25]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/abc.f90"' + fpm = fpm//NL//'digest = -1146733275418683599' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_de_abc"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_de_token" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_26]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/merge.f90"' + fpm = fpm//NL//'digest = -8357953095488542628' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build_merge"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_27]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/keyval.f90"' + fpm = fpm//NL//'digest = -4107572447442746790' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build_keyval"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_error", "tomlf_type", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_28]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/table.f90"' + fpm = fpm//NL//'digest = 3419266420890706227' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build_table"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build_keyval", "tomlf_constants", "tomlf_datetime", "tomlf_error", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_29]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/array.f90"' + fpm = fpm//NL//'digest = 5731959908631518546' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build_array"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build_keyval", "tomlf_error", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_30]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/path.f90"' + fpm = fpm//NL//'digest = 1001559863484583002' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_build_path"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_build_table", "tomlf_error", "tomlf_type" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_31]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/node.f90"' + fpm = fpm//NL//'digest = 4105605469572416054' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure_node"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = "tomlf_type_value"' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_32]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/array_list.f90"' + fpm = fpm//NL//'digest = 1707150725310470906' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure_array_list"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_33]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/ordered_map.f90"' + fpm = fpm//NL//'digest = 9194757273934069933' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure_ordered_map"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_34]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/map.f90"' + fpm = fpm//NL//'digest = 10697944851042277' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure_map"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.toml-f.sources.src_35]' + fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/list.f90"' + fpm = fpm//NL//'digest = 6018335058365199200' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "tomlf_structure_list"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.M_CLI2]' + fpm = fpm//NL//'name = "M_CLI2"' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[packages.M_CLI2.fortran]' + fpm = fpm//NL//'implicit-typing = false' + fpm = fpm//NL//'implicit-external = false' + fpm = fpm//NL//'source-form = "free"' + fpm = fpm//NL//'[packages.M_CLI2.sources]' + fpm = fpm//NL//'[packages.M_CLI2.sources.src_1]' + fpm = fpm//NL//'file-name = "build/dependencies/M_CLI2/src/M_CLI2.F90"' + fpm = fpm//NL//'digest = -6169834068995303802' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "m_cli2"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.jonquil]' + fpm = fpm//NL//'name = "jonquil"' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[packages.jonquil.fortran]' + fpm = fpm//NL//'implicit-typing = false' + fpm = fpm//NL//'implicit-external = false' + fpm = fpm//NL//'source-form = "free"' + fpm = fpm//NL//'[packages.jonquil.sources]' + fpm = fpm//NL//'[packages.jonquil.sources.src_1]' + fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil.f90"' + fpm = fpm//NL//'digest = 5552073973512025871' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "jonquil"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf", "tomlf_type", "jonquil_ser" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.jonquil.sources.src_2]' + fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/version.f90"' + fpm = fpm//NL//'digest = -2934903401983932826' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "jonquil_version"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.jonquil.sources.src_3]' + fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/ser.f90"' + fpm = fpm//NL//'digest = 2690773570566028936' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "jonquil_ser"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_error", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.jonquil.sources.src_4]' + fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/lexer.f90"' + fpm = fpm//NL//'digest = 4057038173684122483' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "jonquil_lexer"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_utils" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'[packages.jonquil.sources.src_5]' + fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/parser.f90"' + fpm = fpm//NL//'digest = -2426842130572494815' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' + fpm = fpm//NL//'modules-provided = "jonquil_parser"' + fpm = fpm//NL//'parent-modules = [ ]' + fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_de_context" ]' + fpm = fpm//NL//'include-dependencies = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + + ! Write + open(newunit=iunit,form='formatted',status='scratch') + + !> Dump to scratch file + write(iunit,*) fpm + + !> Load from scratch file + rewind(iunit) + call toml_load(table, iunit) + + close(iunit) + + end subroutine fpm_081_table + + subroutine fpm_model_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + type(fpm_model_t) :: model + type(toml_table), allocatable :: table + + call model%test_serialization('fpm_model_t: default object', error) + if (allocated(error)) return + + !> Now init form fpm 0.8.1 table + call fpm_081_table(table) + + call model%load(table, error) + if (allocated(error)) then + call fatal_error(error, 'fpm_model_t: cannot load model from fpm v0.8.1 TOML') + return + end if + + call model%test_serialization('fpm_model_t: fpm v0.8.1 model test', error) + + end subroutine fpm_model_roundtrip + end module test_toml From 679327a777b553470e7f1d26e0ba64d90c972f4b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 09:34:32 +0200 Subject: [PATCH 33/80] add failing tests --- src/fpm/dependency.f90 | 49 +++++- src/fpm_model.f90 | 8 +- test/fpm_test/test_toml.f90 | 338 +++++++++++++++++++++++++++++++++--- 3 files changed, 366 insertions(+), 29 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 45c9cc44ce..c78a758dd2 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1350,6 +1350,7 @@ subroutine node_load_from_toml(self, table, error) !> Local variables character(len=:), allocatable :: version + integer :: ierr call destroy_dependency_node(self) @@ -1357,9 +1358,30 @@ subroutine node_load_from_toml(self, table, error) call self%dependency_config_t%load_from_toml(table, error) if (allocated(error)) return - call get_value(table, "done", self%done) - call get_value(table, "update", self%update) - call get_value(table, "cached", self%cached) + call get_value(table, "done", self%done, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot read done flag in TOML table') + return + end if + + call get_value(table, "update", self%update, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot read update flag in TOML table') + return + end if + + call get_value(table, "cached", self%cached, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot read cached flag in TOML table') + return + end if + + call get_value(table, "done", self%done, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_node_t: cannot read done flag in TOML table') + return + end if + call get_value(table, "proj-dir", self%proj_dir) call get_value(table, "revision", self%revision) @@ -1528,9 +1550,24 @@ subroutine tree_load_from_toml(self, table, error) call table%get_keys(keys) - call get_value(table, "unit", self%unit) - call get_value(table, "verbosity", self%verbosity) - call get_value(table, "ndep", self%ndep) + call get_value(table, "unit", self%unit, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + return + end if + + call get_value(table, "verbosity", self%verbosity, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + return + end if + + call get_value(table, "ndep", self%ndep, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + return + end if + call get_value(table, "dep-dir", self%dep_dir) call get_value(table, "cache", self%cache) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index f0593b16b1..18110571a7 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -569,10 +569,16 @@ subroutine srcfile_load_from_toml(self, table, error) type(error_t), allocatable, intent(out) :: error character(len=:), allocatable :: flag + integer :: ierr call get_value(table, "file-name", self%file_name) call get_value(table, "exe-name", self%exe_name) - call get_value(table, "digest", self%digest) + + call get_value(table, "digest", self%digest, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'srcfile_t: cannot set digest in TOML table') + return + end if ! unit_scope and unit_type are saved as strings so the output is independent ! of the internal representation diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index d7afad507a..0162472b42 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -9,7 +9,8 @@ module test_toml use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split - use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t + use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & + & srcfile_t use fpm_compiler, only: archiver_t, compiler_t, id_gcc implicit none @@ -17,6 +18,7 @@ module test_toml public :: collect_toml + character, parameter :: NL = new_line('a') contains @@ -28,19 +30,30 @@ subroutine collect_toml(testsuite) type(unittest_t), allocatable, intent(out) :: testsuite(:) testsuite = [ & - & new_unittest("valid-toml", test_valid_toml), & - & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & - & new_unittest("missing-file", test_missing_file, should_fail=.true.), & - & new_unittest("serialize-git-target", git_target_roundtrip), & - & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & - & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & - & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & - & new_unittest("serialize-string-array", string_array_roundtrip), & - & new_unittest("serialize-fortran-features", fft_roundtrip), & - & new_unittest("serialize-package", package_roundtrip), & - & new_unittest("serialize-archiver", ar_roundtrip), & - & new_unittest("serialize-compiler", compiler_roundtrip), & - & new_unittest("serialize-model", fpm_model_roundtrip)] + & new_unittest("valid-toml", test_valid_toml), & + & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & + & new_unittest("missing-file", test_missing_file, should_fail=.true.), & + & new_unittest("serialize-git-target", git_target_roundtrip), & + & new_unittest("serialize-git-invalid", git_target_invalid, should_fail=.true.), & + & new_unittest("serialize-dependency-config", dependency_config_roundtrip), & + & new_unittest("serialize-dependency-node", dependency_node_roundtrip), & + & new_unittest("serialize-dependency-invalid", dependency_node_invalid, should_fail=.true.), & + & new_unittest("serialize-dependency-invalid2", dependency_node_invalid_2, should_fail=.true.), & + & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & + & new_unittest("serialize-dependency-tree-invalid", dependency_tree_invalid, should_fail=.true.), & + & new_unittest("serialize-dependency-tree-invalid2", dependency_tree_invalid2, should_fail=.true.), & + & new_unittest("serialize-string-array", string_array_roundtrip), & + & new_unittest("serialize-fortran-features", fft_roundtrip), & + & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & + & new_unittest("serialize-package", package_roundtrip), & + & new_unittest("serialize-package-invalid", package_invalid, should_fail=.true.), & + & new_unittest("serialize-srcfile-invalid", source_invalid, should_fail=.true.), & + & new_unittest("serialize-archiver", ar_roundtrip), & + & new_unittest("serialize-archiver-invalid", ar_invalid, should_fail=.true.), & + & new_unittest("serialize-compiler", compiler_roundtrip), & + & new_unittest("serialize-compiler-invalid", compiler_invalid, should_fail=.true.), & + & new_unittest("serialize-model", fpm_model_roundtrip), & + & new_unittest("serialize-model-invalid", fpm_model_invalid, should_fail=.true.)] end subroutine collect_toml @@ -162,6 +175,26 @@ subroutine git_target_roundtrip(error) end subroutine git_target_roundtrip + !> Test invalid git_target_t serialization + subroutine git_target_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(git_target_t) :: git + type(toml_table), allocatable :: table + + character(*), parameter :: toml = 'descriptor = ""'//NL//& ! invalid descriptor ID + 'url = "https://github.com/toml-f/toml-f"'//NL//& + 'object = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f"' + + + call string_to_toml(toml, table) + + call git%load(table, error) + + end subroutine git_target_invalid + !> Test git_target_t serialization subroutine dependency_config_roundtrip(error) @@ -286,6 +319,51 @@ subroutine dependency_node_roundtrip(error) end subroutine dependency_node_roundtrip + !> Test loading invalid dependency node + subroutine dependency_node_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(dependency_node_t) :: dep + type(toml_table), allocatable :: table + + character(*), parameter :: toml = 'name = "jonquil" '//NL//& + & 'version = "h0.2.0"'//NL//& ! invalid version + & 'proj-dir = "build/dependencies/jonquil"'//NL//& + & 'revision = "05d30818bb12fb877226ce284b9a3a41b971a889"'//NL//& + & 'done = true'//NL//& + & 'update = false'//NL//& + & 'cached = true' + + call string_to_toml(toml, table) + + call dep%load(table, error) + + end subroutine dependency_node_invalid + + !> Test loading invalid dependency node + subroutine dependency_node_invalid_2(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(dependency_node_t) :: dep + type(toml_table), allocatable :: table + + character(*), parameter :: toml = 'name = "jonquil" '//NL//& + & 'version = "0.2.0"'//NL//& + & 'proj-dir = "build/dependencies/jonquil"'//NL//& + & 'revision = "05d30818bb12fb877226ce284b9a3a41b971a889"'//NL//& + & 'done = 123'//NL//& ! not a boolean + & 'update = false'//NL//& + & 'cached = true' + + call string_to_toml(toml, table) + call dep%load(table, error) + + end subroutine dependency_node_invalid_2 + !> Test dependency_tree_t serialization subroutine dependency_tree_roundtrip(error) @@ -349,12 +427,73 @@ subroutine dependency_tree_roundtrip(error) call deps%test_serialization("no deps dir", error) if (allocated(error)) return - - 1 format('removed ',i0,' dependencies') end subroutine dependency_tree_roundtrip + !> Test invalid dependency tree loading + subroutine dependency_tree_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + type(dependency_tree_t) :: dep + + character(len=*), parameter :: toml = & + & 'unit = 6 '//NL//& + & 'verbosity = true'//NL//& ! not a number + & 'dep-dir = "build/dependencies"'//NL//& + & 'ndep = 3'//NL//& ! consistency is not checked: + & '[dependencies]'//NL//& + & '[dependencies.dep1]'//NL//& + & 'name = "dep1"'//NL//& + & 'path = "fpm-tmp1-dir"'//NL//& + & 'proj-dir = "fpm-tmp1-dir"'//NL//& + & 'done = false'//NL//& + & 'update = false'//NL//& + & 'cached = false' + + call string_to_toml(toml, table) + call dep%load(table, error) + + end subroutine dependency_tree_invalid + + !> Test invalid dependency tree loading + subroutine dependency_tree_invalid2(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + type(dependency_tree_t) :: dep + + character(len=*), parameter :: toml = & + & 'unit = "" '//NL//& ! not provided + & 'verbosity = 1'//NL//& + & 'dep-dir = "build/dependencies"'//NL//& + & 'ndep = 3'//NL//& ! consistency is not checked: + & '[dependencies.M_CLI2]'//NL//& + & 'name = "M_CLI2"'//NL//& + & 'path = "~/./some/dummy/path"'//NL//& + & 'namespace = "urbanjost"'//NL//& + & 'requested_version = "3.2.0"'//NL//& + & 'version = "4.53.2"'//NL//& + & 'proj-dir = "~/./"'//NL//& + & 'revision = "7264878cdb1baff7323cc48596d829ccfe7751b8"'//NL//& + & 'done = false'//NL//& + & 'update = true'//NL//& + & 'cached = true'//NL//& + & '[dependencies.M_CLI2.git]'//NL//& + & 'descriptor = "revision"'//NL//& + & 'url = "https://github.com/urbanjost/M_CLI2.git"'//NL//& + & 'object = "7264878cdb1baff7323cc48596d829ccfe7751b8"' + + call string_to_toml(toml, table) + call dep%load(table, error) + + end subroutine dependency_tree_invalid2 + !> Test serialization/deserialization of a string array subroutine string_array_roundtrip(error) @@ -463,6 +602,26 @@ subroutine fft_roundtrip(error) end subroutine fft_roundtrip + !> Test deserialization of an invalid fortran-features structure + subroutine fft_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fortran_features_t) :: fortran + type(toml_table), allocatable :: table + + character(len=*), parameter :: toml = 'implicit-typing = false '//NL//& + & 'implicit-external = 0 '//NL//& ! not a boolean + & 'source-form = "free" ' + + call string_to_toml(toml, table) + + !> Default object + call fortran%load(table,error) + + end subroutine fft_invalid + !> Test serialization/deserialization of a package_t structure subroutine package_roundtrip(error) @@ -545,6 +704,55 @@ subroutine package_roundtrip(error) end subroutine package_roundtrip + !> Test deserialization of an invalid package TOML file + subroutine package_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: toml = & + & 'name = "toml-f" '//NL//& + & 'version = "0.8.0" '//NL//& + & 'module-naming = "prefix" '//NL//& ! this should be boolean + & 'module-prefix = "" ' + + type(package_t) :: pkg + type(toml_table), allocatable :: table + + call string_to_toml(toml, table) + + !> Default object + call pkg%load(table,error) + + end subroutine package_invalid + + !> Test deserialization of an invalid source file + subroutine source_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: toml = & + & 'file-name = "build/dependencies/toml-f/src/tomlf.f90" '//NL//& + & 'digest = "abcde" '//NL//& ! not a number + & 'unit-scope = "FPM_SCOPE_MODULE" '//NL//& + & 'unit-type = "FPM_UNIT_MODULE" '//NL//& + & 'modules-provided = "tomlf" '//NL//& + & 'parent-modules = [ ] '//NL//& + & 'modules-used = [ "tomlf_build", "tomlf_datetime" ] '//NL//& + & 'include-dependencies = [ ] '//NL//& + & 'link-libraries = [ ] ' + + type(srcfile_t) :: src + type(toml_table), allocatable :: table + + call string_to_toml(toml, table) + + !> Default object + call src%load(table,error) + + end subroutine source_invalid + !> Test serialization/deserialization of an archiver_t structure subroutine ar_roundtrip(error) @@ -567,6 +775,27 @@ subroutine ar_roundtrip(error) end subroutine ar_roundtrip + !> Test deserialization of an invalid archiver_t structure + subroutine ar_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: toml = & + & 'ar = "ar -rs " '//NL//& + & 'use-response-file = false '//NL//& + & 'echo = 123 '//NL//& ! not a boolean + & 'verbose = false ' + + type(archiver_t) :: ar + type(toml_table), allocatable :: table + + call string_to_toml(toml, table) + + !> Default object + call ar%load(table,error) + + end subroutine ar_invalid !> Test serialization/deserialization of a compiler_t structure subroutine compiler_roundtrip(error) @@ -587,12 +816,34 @@ subroutine compiler_roundtrip(error) compiler%cxx = "g++ -O3 -std=c++11" compiler%echo = .false. - call compiler%dump('compiler.toml',error) - call compiler%test_serialization('compiler_t: gcc',error) end subroutine compiler_roundtrip + !> Test deserialization of an invalid compiler_t TOML structure + subroutine compiler_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=*), parameter :: toml = & + & 'id = "gfortran" '//NL//& ! not an integer identifier + & 'fc = "gfortran" '//NL//& + & 'cc = "gcc" '//NL//& + & 'cxx = "g++" '//NL//& + & 'echo = false '//NL//& + & 'verbose = false ' + + type(compiler_t) :: cc + type(toml_table), allocatable :: table + + call string_to_toml(toml, table) + + !> Default object + call cc%load(table,error) + + end subroutine compiler_invalid + !> Get a simplified TOML representation of the fpm v0.8.1 model subroutine fpm_081_table(table) @@ -600,7 +851,6 @@ subroutine fpm_081_table(table) type(toml_table), allocatable, intent(out) :: table !> simplified TOML representation of the fpm v0.8.1 model - character, parameter :: NL = new_line('a') character(len=:), allocatable :: fpm integer :: iunit @@ -1812,11 +2062,26 @@ subroutine fpm_081_table(table) fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' + call string_to_toml(fpm, table) + + end subroutine fpm_081_table + + !> Convert a character string to a TOML table + subroutine string_to_toml(string, table) + + !> The input TOML as a string + character(*), intent(in) :: string + + !> The TOML table + type(toml_table), allocatable, intent(out) :: table + + integer :: iunit + ! Write - open(newunit=iunit,form='formatted',status='scratch') + open(newunit=iunit,form='formatted',status='scratch',action='readwrite') !> Dump to scratch file - write(iunit,*) fpm + write(iunit,*) string !> Load from scratch file rewind(iunit) @@ -1824,7 +2089,7 @@ subroutine fpm_081_table(table) close(iunit) - end subroutine fpm_081_table + end subroutine string_to_toml subroutine fpm_model_roundtrip(error) @@ -1849,4 +2114,33 @@ subroutine fpm_model_roundtrip(error) end subroutine fpm_model_roundtrip + + subroutine fpm_model_invalid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fpm_model_t) :: model + type(toml_table), allocatable :: table + character(len=:), allocatable :: fpm + + allocate(character(len=0) :: fpm) + fpm = fpm//NL//'package-name = "fpm"' + fpm = fpm//NL//'fortran-flags = " -Wall -Wextra -fPIC -fmax-errors=1 -g "' + fpm = fpm//NL//'c-flags = ""' + fpm = fpm//NL//'cxx-flags = ""' + fpm = fpm//NL//'link-flags = ""' + fpm = fpm//NL//'build-prefix = "build/gfortran"' + fpm = fpm//NL//'include-dirs = [ ]' + fpm = fpm//NL//'link-libraries = [ ]' + fpm = fpm//NL//'external-modules = "" ' + fpm = fpm//NL//'include-tests = "my_test"' ! not a boolean + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + + call string_to_toml(fpm, table) + call model%load(table,error) + + end subroutine fpm_model_invalid + end module test_toml From ae56c6522b318211f721b32bb1194641e7b13ca0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 09:37:20 +0200 Subject: [PATCH 34/80] shorten fpm 0.8.1 table --- test/fpm_test/test_toml.f90 | 1088 ++--------------------------------- 1 file changed, 45 insertions(+), 1043 deletions(-) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 0162472b42..ed54db07a5 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -844,7 +844,7 @@ subroutine compiler_invalid(error) end subroutine compiler_invalid - !> Get a simplified TOML representation of the fpm v0.8.1 model + !> Get a shortened TOML representation of the fpm v0.8.1 model subroutine fpm_081_table(table) !> TOML representation of the fpm v0.8.1 model @@ -907,707 +907,69 @@ subroutine fpm_081_table(table) fpm = fpm//NL//'descriptor = "revision"' fpm = fpm//NL//'url = "https://github.com/toml-f/toml-f"' fpm = fpm//NL//'object = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f"' - fpm = fpm//NL//'[deps.dependencies.M_CLI2]' - fpm = fpm//NL//'name = "M_CLI2"' - fpm = fpm//NL//'version = "1.0.0"' - fpm = fpm//NL//'proj-dir = "build/dependencies/M_CLI2"' - fpm = fpm//NL//'revision = "7264878cdb1baff7323cc48596d829ccfe7751b8"' - fpm = fpm//NL//'done = true' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = true' - fpm = fpm//NL//'[deps.dependencies.M_CLI2.git]' - fpm = fpm//NL//'descriptor = "revision"' - fpm = fpm//NL//'url = "https://github.com/urbanjost/M_CLI2.git"' - fpm = fpm//NL//'object = "7264878cdb1baff7323cc48596d829ccfe7751b8"' - fpm = fpm//NL//'[deps.dependencies.jonquil]' - fpm = fpm//NL//'name = "jonquil"' - fpm = fpm//NL//'version = "0.2.0"' - fpm = fpm//NL//'proj-dir = "build/dependencies/jonquil"' - fpm = fpm//NL//'revision = "05d30818bb12fb877226ce284b9a3a41b971a889"' - fpm = fpm//NL//'done = true' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = true' - fpm = fpm//NL//'[deps.dependencies.jonquil.git]' - fpm = fpm//NL//'descriptor = "revision"' - fpm = fpm//NL//'url = "https://github.com/toml-f/jonquil"' - fpm = fpm//NL//'object = "05d30818bb12fb877226ce284b9a3a41b971a889"' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_5]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_6]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_7]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_8]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_9]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_10]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_11]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_12]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_13]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_14]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_15]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_16]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_17]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_18]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_19]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_20]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_21]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_22]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_23]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_24]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_25]' - fpm = fpm//NL//'done = false' - fpm = fpm//NL//'update = false' - fpm = fpm//NL//'cached = false' - fpm = fpm//NL//'[packages]' - fpm = fpm//NL//'[packages.fpm]' - fpm = fpm//NL//'name = "fpm"' - fpm = fpm//NL//'version = "0.8.0"' - fpm = fpm//NL//'module-naming = false' - fpm = fpm//NL//'module-prefix = ""' - fpm = fpm//NL//'[packages.fpm.fortran]' - fpm = fpm//NL//'implicit-typing = false' - fpm = fpm//NL//'implicit-external = false' - fpm = fpm//NL//'source-form = "free"' - fpm = fpm//NL//'[packages.fpm.sources]' - fpm = fpm//NL//'[packages.fpm.sources.src_1]' - fpm = fpm//NL//'file-name = "././src/fpm.f90"' - fpm = fpm//NL//'digest = 4322290725857190613' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_strings", "fpm_backend", "fpm_compiler", "fpm_error" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_2]' - fpm = fpm//NL//'file-name = "././src/fpm_backend.F90"' - fpm = fpm//NL//'digest = -3210121688944515946' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_backend"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_backend_output" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_3]' - fpm = fpm//NL//'file-name = "././src/fpm_environment.f90"' - fpm = fpm//NL//'digest = 2235607720245152632' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_environment"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "fpm_error"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_4]' - fpm = fpm//NL//'file-name = "././src/fpm_model.f90"' - fpm = fpm//NL//'digest = -6774177234665080583' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_model"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_compiler", "fpm_dependency" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_5]' - fpm = fpm//NL//'file-name = "././src/filesystem_utilities.c"' - fpm = fpm//NL//'digest = 4957633104775755438' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_6]' - fpm = fpm//NL//'file-name = "././src/fpm_filesystem.F90"' - fpm = fpm//NL//'digest = 1871084827152368652' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_filesystem"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_environment" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_7]' - fpm = fpm//NL//'file-name = "././src/fpm_strings.f90"' - fpm = fpm//NL//'digest = 7038915013685504829' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_strings"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_8]' - fpm = fpm//NL//'file-name = "././src/fpm_settings.f90"' - fpm = fpm//NL//'digest = -885425387141891996' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_settings"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment", "fpm_error" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_9]' - fpm = fpm//NL//'file-name = "././src/fpm_os.c"' - fpm = fpm//NL//'digest = -4523865409175594663' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_10]' - fpm = fpm//NL//'file-name = "././src/fpm_backend_console.f90"' - fpm = fpm//NL//'digest = 1732983699585955966' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_backend_console"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_11]' - fpm = fpm//NL//'file-name = "././src/fpm_source_parsing.f90"' - fpm = fpm//NL//'digest = 6098986130375861226' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_source_parsing"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_model", "fpm_filesystem" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_12]' - fpm = fpm//NL//'file-name = "././src/fpm_os.F90"' - fpm = fpm//NL//'digest = -4743856136050054640' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_os"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment", "fpm_error" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_13]' - fpm = fpm//NL//'file-name = "././src/fpm_compiler.F90"' - fpm = fpm//NL//'digest = -2442073797366752057' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_compiler"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_filesystem", "fpm_strings" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_14]' - fpm = fpm//NL//'file-name = "././src/fpm_command_line.f90"' - fpm = fpm//NL//'digest = 7180707928326338392' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_command_line"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_environment", "m_cli2", "m_cli2", "fpm_strings" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_15]' - fpm = fpm//NL//'file-name = "././src/fpm_backend_output.f90"' - fpm = fpm//NL//'digest = 7154367044486334558' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_backend_output"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_targets", "fpm_backend_console" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_16]' - fpm = fpm//NL//'file-name = "././src/fpm_targets.f90"' - fpm = fpm//NL//'digest = -8234965779941208361' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_targets"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_model", "fpm_compiler", "fpm_environment" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_17]' - fpm = fpm//NL//'file-name = "././src/fpm_sources.f90"' - fpm = fpm//NL//'digest = 3391120653956350167' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_sources"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_model", "fpm_filesystem", "fpm_strings" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_18]' - fpm = fpm//NL//'file-name = "././src/ptycheck/iscygpty.c"' - fpm = fpm//NL//'digest = -4887164695298162637' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = "iscygpty.h"' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_19]' - fpm = fpm//NL//'file-name = "././src/ptycheck/isatty.c"' - fpm = fpm//NL//'digest = 6664536934601490990' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = "iscygpty.h"' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_20]' - fpm = fpm//NL//'file-name = "././src/ptycheck/iscygpty.h"' - fpm = fpm//NL//'digest = -3550201113101300999' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_CHEADER"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_21]' - fpm = fpm//NL//'file-name = "././src/fpm/downloader.f90"' - fpm = fpm//NL//'digest = 620358568720613499' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_SUBPROGRAM"' - fpm = fpm//NL//'modules-provided = "fpm_downloader"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_versioning", "jonquil" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_22]' - fpm = fpm//NL//'file-name = "././src/fpm/error.f90"' - fpm = fpm//NL//'digest = 7324399436715753500' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_error"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "fpm_strings"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_23]' - fpm = fpm//NL//'file-name = "././src/fpm/toml.f90"' - fpm = fpm//NL//'digest = 2411620725015864401' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_toml"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "tomlf" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_24]' - fpm = fpm//NL//'file-name = "././src/fpm/installer.f90"' - fpm = fpm//NL//'digest = 581769321360482292' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_installer"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_error", "fpm_filesystem" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_25]' - fpm = fpm//NL//'file-name = "././src/fpm/versioning.f90"' - fpm = fpm//NL//'digest = -1370610786727991294' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_versioning"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "fpm_error"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_26]' - fpm = fpm//NL//'file-name = "././src/fpm/git.f90"' - fpm = fpm//NL//'digest = -7368368636549243157' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_git"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_27]' - fpm = fpm//NL//'file-name = "././src/fpm/dependency.f90"' - fpm = fpm//NL//'digest = -2836785909441977019' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_dependency"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_environment", "fpm_error", "fpm_filesystem"]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_28]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest.f90"' - fpm = fpm//NL//'digest = -1346850924839827718' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_manifest_build", "fpm_manifest_example" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_29]' - fpm = fpm//NL//'file-name = "././src/fpm/cmd/new.f90"' - fpm = fpm//NL//'digest = 697853208011446608' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_cmd_new"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_environment" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_30]' - fpm = fpm//NL//'file-name = "././src/fpm/cmd/update.f90"' - fpm = fpm//NL//'digest = -8232305547308400988' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_cmd_update"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_manifest" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_31]' - fpm = fpm//NL//'file-name = "././src/fpm/cmd/install.f90"' - fpm = fpm//NL//'digest = -6707501025391219376' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_cmd_install"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm", "fpm_backend", "fpm_command_line" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_32]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/test.f90"' - fpm = fpm//NL//'digest = 1399197227023080626' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_test"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_33]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/profiles.f90"' - fpm = fpm//NL//'digest = -7975317648924650587' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_profile"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml", "fpm_strings", "fpm_filesystem" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_34]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/example.f90"' - fpm = fpm//NL//'digest = 2220193652669081694' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_example"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_35]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/executable.f90"' - fpm = fpm//NL//'digest = 2826537585451151940' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_executable"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_manifest_dependency", "fpm_error", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_36]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/install.f90"' - fpm = fpm//NL//'digest = 6941308343630725905' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_install"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_37]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/package.f90"' - fpm = fpm//NL//'digest = 4046915203104200691' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_package"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_manifest_build", "fpm_manifest_dependency", ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_38]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/preprocess.f90"' - fpm = fpm//NL//'digest = 4463864760686846214' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_mainfest_preprocess"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_39]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/build.f90"' - fpm = fpm//NL//'digest = 7486174362460284832' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_build"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_40]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/dependency.f90"' - fpm = fpm//NL//'digest = -6006235286439662663' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_dependency"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_git", "fpm_versioning" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_41]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/library.f90"' - fpm = fpm//NL//'digest = -1698783511442136567' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_library"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_strings", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_42]' - fpm = fpm//NL//'file-name = "././src/fpm/manifest/fortran.f90"' - fpm = fpm//NL//'digest = -6768952943164424742' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "fpm_manifest_fortran"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_toml" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_43]' - fpm = fpm//NL//'file-name = "app/main.f90"' - fpm = fpm//NL//'exe-name = "fpm"' - fpm = fpm//NL//'digest = 7759460120440225004' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_APP"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm_os" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_44]' - fpm = fpm//NL//'file-name = "test/help_test/help_test.f90"' - fpm = fpm//NL//'exe-name = "help-test"' - fpm = fpm//NL//'digest = -7601948172740854190' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' - fpm = fpm//NL//'modules-provided = [ ]' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "fpm_environment" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_45]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_os.f90"' - fpm = fpm//NL//'digest = 718441623146001654' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_os"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_environment", "fpm_os" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_46]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_source_parsing.f90"' - fpm = fpm//NL//'digest = 5852386252678959798' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_SUBPROGRAM"' - fpm = fpm//NL//'modules-provided = "test_source_parsing"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_strings" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_47]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_settings.f90"' - fpm = fpm//NL//'digest = -3541669032396077479' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_settings"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_settings", "fpm_filesystem", "fpm_os" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_48]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_backend.f90"' - fpm = fpm//NL//'digest = 2723265999281936523' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_backend"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "test_module_dependencies", "fpm_backend" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_49]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_versioning.f90"' - fpm = fpm//NL//'digest = 7879213895027593947' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_versioning"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_versioning" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_50]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_manifest.f90"' - fpm = fpm//NL//'digest = -5417606542127631442' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_manifest"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "testsuite", "fpm_manifest" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_51]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_filesystem.f90"' - fpm = fpm//NL//'digest = -3128825714354096496' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'[deps.dependencies.UNNAMED_DEPENDENCY_5]' + fpm = fpm//NL//'done = false' + fpm = fpm//NL//'update = false' + fpm = fpm//NL//'cached = false' + fpm = fpm//NL//'[packages]' + fpm = fpm//NL//'[packages.fpm]' + fpm = fpm//NL//'name = "fpm"' + fpm = fpm//NL//'version = "0.8.0"' + fpm = fpm//NL//'module-naming = false' + fpm = fpm//NL//'module-prefix = ""' + fpm = fpm//NL//'[packages.fpm.fortran]' + fpm = fpm//NL//'implicit-typing = false' + fpm = fpm//NL//'implicit-external = false' + fpm = fpm//NL//'source-form = "free"' + fpm = fpm//NL//'[packages.fpm.sources]' + fpm = fpm//NL//'[packages.fpm.sources.src_1]' + fpm = fpm//NL//'file-name = "././src/fpm.f90"' + fpm = fpm//NL//'digest = 4322290725857190613' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_filesystem"' + fpm = fpm//NL//'modules-provided = "fpm"' fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_filesystem", "fpm_environment" ]' + fpm = fpm//NL//'modules-used = [ "fpm_strings", "fpm_backend", "fpm_compiler", "fpm_error" ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_52]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_installer.f90"' - fpm = fpm//NL//'digest = 6893981694820313345' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'[packages.fpm.sources.src_2]' + fpm = fpm//NL//'file-name = "././src/fpm_backend.F90"' + fpm = fpm//NL//'digest = -3210121688944515946' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_installer"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_environment", "fpm_filesystem", "fpm_installer" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_53]' - fpm = fpm//NL//'file-name = "test/fpm_test/main.f90"' - fpm = fpm//NL//'exe-name = "fpm-test"' - fpm = fpm//NL//'digest = -6659997723519103741' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' - fpm = fpm//NL//'modules-provided = [ ]' + fpm = fpm//NL//'modules-provided = "fpm_backend"' fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "test_toml", "test_manifest", "test_os" ]' + fpm = fpm//NL//'modules-used = [ "fpm_error", "fpm_filesystem", "fpm_backend_output" ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_54]' - fpm = fpm//NL//'file-name = "test/fpm_test/testsuite.f90"' - fpm = fpm//NL//'digest = 4708439108904007602' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'[packages.fpm.sources.src_3]' + fpm = fpm//NL//'file-name = "././src/fpm_environment.f90"' + fpm = fpm//NL//'digest = 2235607720245152632' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "testsuite"' + fpm = fpm//NL//'modules-provided = "fpm_environment"' fpm = fpm//NL//'parent-modules = [ ]' fpm = fpm//NL//'modules-used = "fpm_error"' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_55]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_toml.f90"' - fpm = fpm//NL//'digest = -4238391920328466228' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_toml"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_toml", "tomlf_constants", "fpm_compiler" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_56]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_package_dependencies.f90"' - fpm = fpm//NL//'digest = 1143008373292682612' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_package_dependencies"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_filesystem", "testsuite", "fpm_versioning", "jonquil" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_57]' - fpm = fpm//NL//'file-name = "test/fpm_test/test_module_dependencies.f90"' - fpm = fpm//NL//'digest = -8398823885747598218' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' + fpm = fpm//NL//'[packages.fpm.sources.src_4]' + fpm = fpm//NL//'file-name = "././src/fpm_model.f90"' + fpm = fpm//NL//'digest = -6774177234665080583' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "test_module_dependencies"' + fpm = fpm//NL//'modules-provided = "fpm_model"' fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "testsuite", "fpm_targets", "fpm" ]' + fpm = fpm//NL//'modules-used = [ "fpm_compiler", "fpm_dependency" ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.fpm.sources.src_58]' - fpm = fpm//NL//'file-name = "test/cli_test/cli_test.f90"' - fpm = fpm//NL//'exe-name = "cli-test"' - fpm = fpm//NL//'digest = 7502982943646619950' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_TEST"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_PROGRAM"' + fpm = fpm//NL//'[packages.fpm.sources.src_5]' + fpm = fpm//NL//'file-name = "././src/filesystem_utilities.c"' + fpm = fpm//NL//'digest = 4957633104775755438' + fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' + fpm = fpm//NL//'unit-type = "FPM_UNIT_CSOURCE"' fpm = fpm//NL//'modules-provided = [ ]' fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "fpm_command_line", "fpm", "fpm_cmd_new" ]' + fpm = fpm//NL//'modules-used = [ ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' fpm = fpm//NL//'[packages.fpm.sources.src_59]' @@ -1651,336 +1013,6 @@ subroutine fpm_081_table(table) fpm = fpm//NL//'modules-used = [ ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_3]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/version.f90"' - fpm = fpm//NL//'digest = 7297460108185920032' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_version"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_4]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure.f90"' - fpm = fpm//NL//'digest = -5586939372904264461' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_structure_ordered_map" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_5]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/error.f90"' - fpm = fpm//NL//'digest = -6990387780017431402' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_error"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_constants"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_6]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/ser.f90"' - fpm = fpm//NL//'digest = 2173577414279434444' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_ser"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_7]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de.f90"' - fpm = fpm//NL//'digest = 6984491308379570724' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_8]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils.f90"' - fpm = fpm//NL//'digest = -1654455727593730955' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_utils"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_utils_io" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_9]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/datetime.f90"' - fpm = fpm//NL//'digest = 360194003049506468' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_datetime"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_constants"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_10]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/diagnostic.f90"' - fpm = fpm//NL//'digest = -6145654881147673446' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_diagnostic"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_terminal"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_11]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type.f90"' - fpm = fpm//NL//'digest = 7822704506185839449' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_type"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_12]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build.f90"' - fpm = fpm//NL//'digest = 6734874397655167084' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_build_array", "tomlf_build_table" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_13]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/all.f90"' - fpm = fpm//NL//'digest = -3373616532185720889' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_all"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_build", "tomlf_type", "tomlf_utils", "tomlf_version" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_14]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/terminal.f90"' - fpm = fpm//NL//'digest = 6124874315911091908' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_terminal"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_utils"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_15]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils/sort.f90"' - fpm = fpm//NL//'digest = -7275638313901306893' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_utils_sort"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_type_value"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_16]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/utils/io.f90"' - fpm = fpm//NL//'digest = -4559681945420894782' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_utils_io"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_constants"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_17]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/keyval.f90"' - fpm = fpm//NL//'digest = 7305553188003635285' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_type_keyval"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_18]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/table.f90"' - fpm = fpm//NL//'digest = -1731470661964884986' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_type_table"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_structure" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_19]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/array.f90"' - fpm = fpm//NL//'digest = 5202963073293705116' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_type_array"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_error", "tomlf_type_value", "tomlf_structure" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_20]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/type/value.f90"' - fpm = fpm//NL//'digest = 988208496786453415' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_type_value"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_21]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/context.f90"' - fpm = fpm//NL//'digest = -6236998766484611847' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de_context"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_terminal" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_22]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/lexer.f90"' - fpm = fpm//NL//'digest = -5703883624156149303' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de_lexer"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_error", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_23]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/token.f90"' - fpm = fpm//NL//'digest = -6068697997670165243' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de_token"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_24]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/parser.f90"' - fpm = fpm//NL//'digest = -3187016653233800622' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de_parser"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_25]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/de/abc.f90"' - fpm = fpm//NL//'digest = -1146733275418683599' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_de_abc"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_de_token" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_26]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/merge.f90"' - fpm = fpm//NL//'digest = -8357953095488542628' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build_merge"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_27]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/keyval.f90"' - fpm = fpm//NL//'digest = -4107572447442746790' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build_keyval"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_error", "tomlf_type", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_28]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/table.f90"' - fpm = fpm//NL//'digest = 3419266420890706227' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build_table"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_build_keyval", "tomlf_constants", "tomlf_datetime", "tomlf_error", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_29]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/array.f90"' - fpm = fpm//NL//'digest = 5731959908631518546' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build_array"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_build_keyval", "tomlf_error", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_30]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/build/path.f90"' - fpm = fpm//NL//'digest = 1001559863484583002' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_build_path"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_build_table", "tomlf_error", "tomlf_type" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_31]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/node.f90"' - fpm = fpm//NL//'digest = 4105605469572416054' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure_node"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = "tomlf_type_value"' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_32]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/array_list.f90"' - fpm = fpm//NL//'digest = 1707150725310470906' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure_array_list"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_33]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/ordered_map.f90"' - fpm = fpm//NL//'digest = 9194757273934069933' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure_ordered_map"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_34]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/map.f90"' - fpm = fpm//NL//'digest = 10697944851042277' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure_map"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.toml-f.sources.src_35]' - fpm = fpm//NL//'file-name = "build/dependencies/toml-f/src/tomlf/structure/list.f90"' - fpm = fpm//NL//'digest = 6018335058365199200' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "tomlf_structure_list"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_type_value" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' fpm = fpm//NL//'[packages.M_CLI2]' fpm = fpm//NL//'name = "M_CLI2"' fpm = fpm//NL//'version = "0.8.0"' @@ -2031,36 +1063,6 @@ subroutine fpm_081_table(table) fpm = fpm//NL//'modules-used = [ ]' fpm = fpm//NL//'include-dependencies = [ ]' fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.jonquil.sources.src_3]' - fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/ser.f90"' - fpm = fpm//NL//'digest = 2690773570566028936' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "jonquil_ser"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_error", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.jonquil.sources.src_4]' - fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/lexer.f90"' - fpm = fpm//NL//'digest = 4057038173684122483' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "jonquil_lexer"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_utils" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' - fpm = fpm//NL//'[packages.jonquil.sources.src_5]' - fpm = fpm//NL//'file-name = "build/dependencies/jonquil/src/jonquil/parser.f90"' - fpm = fpm//NL//'digest = -2426842130572494815' - fpm = fpm//NL//'unit-scope = "FPM_SCOPE_LIB"' - fpm = fpm//NL//'unit-type = "FPM_UNIT_MODULE"' - fpm = fpm//NL//'modules-provided = "jonquil_parser"' - fpm = fpm//NL//'parent-modules = [ ]' - fpm = fpm//NL//'modules-used = [ "tomlf_constants", "tomlf_datetime", "tomlf_de_context" ]' - fpm = fpm//NL//'include-dependencies = [ ]' - fpm = fpm//NL//'link-libraries = [ ]' call string_to_toml(fpm, table) From 23e7c09293b099399f78f40d816e98e90f28844e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 10:06:15 +0200 Subject: [PATCH 35/80] set_value, add_table: unify fpm wrapper --- src/fpm/dependency.f90 | 41 +++------ src/fpm/git.f90 | 24 ++---- src/fpm/manifest/dependency.f90 | 48 +++-------- src/fpm/toml.f90 | 133 +++++++++++++++++++++++++++++ src/fpm_compiler.F90 | 50 +++-------- src/fpm_model.f90 | 147 +++++++++----------------------- 6 files changed, 216 insertions(+), 227 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index c78a758dd2..3458861242 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -66,7 +66,7 @@ module fpm_dependency use fpm_manifest_dependency, only: manifest_has_changed, dependency_destroy use fpm_strings, only: string_t, operator(.in.) use fpm_toml, only: toml_table, toml_key, toml_error, toml_serialize, & - get_value, set_value, add_table, toml_load, toml_stat + get_value, set_value, add_table, toml_load, toml_stat, set_string use fpm_versioning, only: version_t, new_version use fpm_settings, only: fpm_global_settings, get_global_settings, official_registry_base_url use fpm_downloader, only: downloader_t @@ -1466,35 +1466,16 @@ subroutine tree_dump_to_toml(self, table, error) type(toml_table), pointer :: ptr_deps,ptr character(27) :: unnamed - call set_value(table, "unit", self%unit, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set unit in TOML table') - return - end if - call set_value(table, "verbosity", self%verbosity, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set verbosity in TOML table') - return - end if - if (allocated(self%dep_dir)) then - call set_value(table, "dep-dir", self%dep_dir, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set dep-dir in TOML table') - return - end if - endif - if (allocated(self%cache)) then - call set_value(table, "cache", self%cache, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set cache in TOML table') - return - end if - endif - call set_value(table, "ndep", self%ndep, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set ndep in TOML table') - return - end if + call set_value(table, "unit", self%unit, error, 'dependency_tree_t') + if (allocated(error)) return + call set_value(table, "verbosity", self%verbosity, error, 'dependency_tree_t') + if (allocated(error)) return + call set_string(table, "dep-dir", self%dep_dir, error, 'dependency_tree_t') + if (allocated(error)) return + call set_string(table, "cache", self%cache, error, 'dependency_tree_t') + if (allocated(error)) return + call set_value(table, "ndep", self%ndep, error, 'dependency_tree_t') + if (allocated(error)) return if (allocated(self%dep)) then diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 64cca94188..471b1826fd 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -2,7 +2,7 @@ module fpm_git use fpm_error, only: error_t, fatal_error use fpm_filesystem, only : get_temp_filename, getline, join_path - use fpm_toml, only: serializable_t, toml_table, get_value, set_value, toml_stat + use fpm_toml, only: serializable_t, toml_table, get_value, set_value, toml_stat, set_string implicit none public :: git_target_t @@ -354,22 +354,12 @@ subroutine dump_to_toml(self, table, error) integer :: ierr - call set_value(table, "descriptor", descriptor_name(self%descriptor)) - if (allocated(self%url)) then - call set_value(table, "url", self%url, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'git_target_t: cannot set url in TOML table') - return - end if - endif - - if (allocated(self%object)) then - call set_value(table, "object", self%object, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'git_target_t: cannot set object in TOML table') - return - end if - endif + call set_string(table, "descriptor", descriptor_name(self%descriptor), error, 'git_target_t') + if (allocated(error)) return + call set_string(table, "url", self%url, error, 'git_target_t') + if (allocated(error)) return + call set_string(table, "object", self%object, error, 'git_target_t') + if (allocated(error)) return end subroutine dump_to_toml diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 1a14b2ef16..c3013178f5 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -27,7 +27,7 @@ module fpm_manifest_dependency use fpm_git, only: git_target_t, git_target_tag, git_target_branch, & & git_target_revision, git_target_default, operator(==), git_matches_manifest use fpm_toml, only: toml_table, toml_key, toml_stat, get_value, check_keys, serializable_t, add_table, & - & set_value + & set_value, set_string use fpm_filesystem, only: windows_path use fpm_environment, only: get_os_type, OS_WINDOWS use fpm_versioning, only: version_t, new_version @@ -368,46 +368,20 @@ subroutine dump_to_toml(self, table, error) integer :: ierr - if (allocated(self%name)) then - call set_value(table, "name", self%name, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_config_t: cannot set name in TOML table') - return - end if - endif - - if (allocated(self%path)) then - call set_value(table, "path", self%path, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_config_t: cannot set path in TOML table') - return - end if - endif - - if (allocated(self%namespace)) then - call set_value(table, "namespace", self%namespace, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_config_t: cannot set namespace in TOML table') - return - end if - endif - + call set_string(table, "name", self%name, error, 'dependency_config_t') + if (allocated(error)) return + call set_string(table, "path", self%path, error, 'dependency_config_t') + if (allocated(error)) return + call set_string(table, "namespace", self%namespace, error, 'dependency_config_t') + if (allocated(error)) return if (allocated(self%requested_version)) then - call set_value(table, "requested_version", self%requested_version%s(), ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_config_t: cannot set requested_version in TOML table') - return - end if + call set_string(table, "requested_version", self%requested_version%s(), error, 'dependency_config_t') + if (allocated(error)) return endif - if (allocated(self%git)) then - call add_table(table, "git", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_config_t: cannot set git table in TOML table') - return - end if - + call add_table(table, "git", ptr, error) + if (allocated(error)) return call self%git%dump_to_toml(ptr, error) if (allocated(error)) return endif diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 5359edf4ea..fe2bae7b48 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -18,6 +18,7 @@ module fpm_toml use tomlf, only: toml_table, toml_array, toml_key, toml_stat, get_value, & & set_value, toml_parse, toml_error, new_table, add_table, add_array, & & toml_serialize, len, toml_load + use iso_fortran_env, only: int64 implicit none private @@ -51,6 +52,18 @@ module fpm_toml end type serializable_t + !> add_table: fpm interface + interface add_table + module procedure add_table_fpm + end interface add_table + + !> set_value: fpm interface + interface set_value + module procedure set_logical + module procedure set_integer + module procedure set_integer_64 + end interface set_value + interface set_string module procedure set_character module procedure set_string_type @@ -395,6 +408,93 @@ subroutine set_character(table, key, var, error, whereAt) end subroutine set_character + !> Function wrapper to set a logical variable to a toml table, returning an fpm error + subroutine set_logical(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + logical, intent(in) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call set_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot set logical key <'//key//'> in TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine set_logical + + !> Function wrapper to set a default integer variable to a toml table, returning an fpm error + subroutine set_integer(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + integer, intent(in) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call set_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot set integer key <'//key//'> in TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine set_integer + + !> Function wrapper to set a default integer variable to a toml table, returning an fpm error + subroutine set_integer_64(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + integer(int64), intent(in) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call set_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot set integer(int64) key <'//key//'> in TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine set_integer_64 + !> Function wrapper to set a character(len=:), allocatable variable to a toml table subroutine set_string_type(table, key, var, error, whereAt) @@ -417,6 +517,39 @@ subroutine set_string_type(table, key, var, error, whereAt) end subroutine set_string_type + !> Function wrapper to add a toml table and return an fpm error + subroutine add_table_fpm(table, key, ptr, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Table key + character(len=*), intent(in) :: key + + !> The character variable + type(toml_table), pointer, intent(out) :: ptr + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + !> Nullify pointer + nullify(ptr) + + call add_table(table, key, ptr, ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot add <'//key//'> table in TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine add_table_fpm + + !> Check if table contains only keys that are part of the list. If a key is !> found that is not part of the list, an error is allocated. subroutine check_keys(table, valid_keys, error) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index b8e3010777..187289c9dc 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -1191,29 +1191,15 @@ subroutine dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr - !> Path to archiver call set_string(table, "ar", self%ar, error, 'archiver_t') if (allocated(error)) return - - call set_value(table, "use-response-file", self%use_response_file, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error dumping use_response_file') - return - end if - - call set_value(table, "echo", self%echo, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error dumping echo') - return - end if - - call set_value(table, "verbose", self%verbose, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error dumping verbose') - return - end if + call set_value(table, "use-response-file", self%use_response_file, error, 'archiver_t') + if (allocated(error)) return + call set_value(table, "echo", self%echo, error, 'archiver_t') + if (allocated(error)) return + call set_value(table, "verbose", self%verbose, error, 'archiver_t') + if (allocated(error)) return end subroutine dump_to_toml @@ -1294,30 +1280,18 @@ subroutine compiler_dump(self, table, error) integer :: ierr - call set_value(table, "id", self%id, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'compiler_t: error dumping id') - return - end if - + call set_value(table, "id", self%id, error, 'compiler_t') + if (allocated(error)) return call set_string(table, "fc", self%fc, error, 'compiler_t') if (allocated(error)) return call set_string(table, "cc", self%cc, error, 'compiler_t') if (allocated(error)) return call set_string(table, "cxx", self%cxx, error, 'compiler_t') if (allocated(error)) return - - call set_value(table, "echo", self%echo, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error dumping echo') - return - end if - - call set_value(table, "verbose", self%verbose, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error dumping verbose') - return - end if + call set_value(table, "echo", self%echo, error, 'compiler_t') + if (allocated(error)) return + call set_value(table, "verbose", self%verbose, error, 'compiler_t') + if (allocated(error)) return end subroutine compiler_dump diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 18110571a7..4732fe48ed 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -515,44 +515,29 @@ subroutine srcfile_dump_to_toml(self, table, error) integer :: ierr - if (allocated(self%file_name)) then - call set_value(table, "file-name", self%file_name, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'srcfile_t: cannot set file-name in TOML table') - return - end if - endif - - if (allocated(self%exe_name)) then - call set_value(table, "exe-name", self%exe_name, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'srcfile_t: cannot set exe-name in TOML table') - return - end if - endif - - call set_value(table,"digest",self%digest) + call set_string(table, "file-name", self%file_name, error, 'srcfile_t') + if (allocated(error)) return + call set_string(table, "exe-name", self%exe_name, error, 'srcfile_t') + if (allocated(error)) return + call set_value(table, "digest", self%digest, error, 'srcfile_t') + if (allocated(error)) return ! unit_scope and unit_type are saved as strings so the output is independent ! of the internal representation - call set_value(table,"unit-scope",FPM_SCOPE_NAME(self%unit_scope)) - call set_value(table,"unit-type",FPM_UNIT_NAME(self%unit_type)) - - call set_list(table,"modules-provided",self%modules_provided, error) + call set_string(table,"unit-scope",FPM_SCOPE_NAME(self%unit_scope), error, 'srcfile_t') if (allocated(error)) return - - call set_list(table,"parent-modules",self%parent_modules, error) + call set_string(table,"unit-type",FPM_UNIT_NAME(self%unit_type), error, 'srcfile_t') if (allocated(error)) return - - call set_list(table,"modules-used",self%modules_used, error) + call set_list(table, "modules-provided",self%modules_provided, error) if (allocated(error)) return - - call set_list(table,"include-dependencies",self%include_dependencies, error) + call set_list(table, "parent-modules",self%parent_modules, error) if (allocated(error)) return - - call set_list(table,"link-libraries",self%link_libraries, error) + call set_list(table, "modules-used",self%modules_used, error) + if (allocated(error)) return + call set_list(table, "include-dependencies",self%include_dependencies, error) + if (allocated(error)) return + call set_list(table, "link-libraries",self%link_libraries, error) if (allocated(error)) return - end subroutine srcfile_dump_to_toml @@ -640,27 +625,12 @@ subroutine fft_dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr - - call set_value(table, "implicit-typing", self%implicit_typing, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fortran_features_t: cannot set implicit-typing in TOML table') - return - end if - - call set_value(table, "implicit-external", self%implicit_external, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fortran_features_t: cannot set implicit-external in TOML table') - return - end if - - if (allocated(self%source_form)) then - call set_value(table, "source-form", self%source_form, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fortran_features_t: cannot set source-form in TOML table') - return - end if - endif + call set_value(table, "implicit-typing", self%implicit_typing, error, 'fortran_features_t') + if (allocated(error)) return + call set_value(table, "implicit-external", self%implicit_external, error, 'fortran_features_t') + if (allocated(error)) return + call set_string(table, "source-form", self%source_form, error, 'fortran_features_t') + if (allocated(error)) return end subroutine fft_dump_to_toml @@ -758,11 +728,8 @@ subroutine package_dump_to_toml(self, table, error) call set_string(table, "version", self%version, error, 'package_t') if (allocated(error)) return - call set_value(table, "module-naming", self%enforce_module_names, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot set module-naming in TOML table') - return - end if + call set_value(table, "module-naming", self%enforce_module_names, error, 'package_t') + if (allocated(error)) return call set_string(table, "module-prefix", self%module_prefix, error, 'package_t') if (allocated(error)) return @@ -771,33 +738,22 @@ subroutine package_dump_to_toml(self, table, error) if (allocated(error)) return !> Create a fortran table - call add_table(table, "fortran", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot set fortran table in TOML table') - return - end if + call add_table(table, "fortran", ptr, error, 'package_t') + if (allocated(error)) return call self%features%dump_to_toml(ptr, error) if (allocated(error)) return !> Create a sources table if (allocated(self%sources)) then - call add_table(table, "sources", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot set sources table in TOML table') - return - end if + call add_table(table, "sources", ptr, error, 'package_t') + if (allocated(error)) return do ii = 1, size(self%sources) write(src_name,1) ii - call add_table(ptr, trim(src_name), this_source) - - if (.not. associated(this_source)) then - call fatal_error(error, "package_t cannot create entry for source "//trim(src_name)) - return - end if - + call add_table(ptr, trim(src_name), this_source, error, 'package_t[source]') + if (allocated(error)) return call self%sources(ii)%dump_to_toml(this_source,error) if (allocated(error)) return @@ -950,19 +906,13 @@ subroutine model_dump_to_toml(self, table, error) call set_string(table, "package-name", self%package_name, error, 'fpm_model_t') if (allocated(error)) return - call add_table(table, "compiler", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot set compiler table') - return - end if + call add_table(table, "compiler", ptr, error, 'fpm_model_t') + if (allocated(error)) return call self%compiler%dump_to_toml(ptr, error) if (allocated(error)) return - call add_table(table, "archiver", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot set archiver table') - return - end if + call add_table(table, "archiver", ptr, error, 'fpm_model_t') + if (allocated(error)) return call self%archiver%dump_to_toml(ptr, error) if (allocated(error)) return @@ -983,25 +933,15 @@ subroutine model_dump_to_toml(self, table, error) call set_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return - call set_value(table, "include-tests", self%include_tests, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fpm_model_t: cannot set include-tests in TOML table') - return - end if - - call set_value(table, "module-naming", self%enforce_module_names, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fpm_model_t: cannot set module-naming in TOML table') - return - end if + call set_value(table, "include-tests", self%include_tests, error, 'fpm_model_t') + if (allocated(error)) return + call set_value(table, "module-naming", self%enforce_module_names, error, 'fpm_model_t') + if (allocated(error)) return call set_string(table, "module-prefix", self%module_prefix, error, 'fpm_model_t') if (allocated(error)) return - call add_table(table, "deps", ptr, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fpm_model_t: cannot set dependencies table') - return - end if + call add_table(table, "deps", ptr, error, 'fpm_model_t') + if (allocated(error)) return call self%deps%dump_to_toml(ptr, error) if (allocated(error)) return @@ -1023,14 +963,11 @@ subroutine model_dump_to_toml(self, table, error) !> So, serialization will work regardless of size(self%dep) == self%ndep if (len_trim(pkg%name)==0) then write(unnamed,1) ii - call add_table(ptr_pkg, trim(unnamed), ptr) + call add_table(ptr_pkg, trim(unnamed), ptr, error, 'fpm_model_t[package]') else - call add_table(ptr_pkg, pkg%name, ptr) - end if - if (.not. associated(ptr)) then - call fatal_error(error, "fpm_model_t cannot create entry for package "//pkg%name) - return + call add_table(ptr_pkg, pkg%name, ptr, error, 'fpm_model_t[package]') end if + if (allocated(error)) return call pkg%dump_to_toml(ptr, error) if (allocated(error)) return From 5c95577972f86029f9a14025871e84933c29ee41 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 10:14:34 +0200 Subject: [PATCH 36/80] unify get_value interface --- src/fpm/dependency.f90 | 29 +++---------- src/fpm/toml.f90 | 93 ++++++++++++++++++++++++++++++++++++++++++ src/fpm_compiler.F90 | 51 ++++++----------------- src/fpm_model.f90 | 47 ++++++--------------- 4 files changed, 123 insertions(+), 97 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 3458861242..2278b4d8d1 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1358,29 +1358,12 @@ subroutine node_load_from_toml(self, table, error) call self%dependency_config_t%load_from_toml(table, error) if (allocated(error)) return - call get_value(table, "done", self%done, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot read done flag in TOML table') - return - end if - - call get_value(table, "update", self%update, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot read update flag in TOML table') - return - end if - - call get_value(table, "cached", self%cached, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot read cached flag in TOML table') - return - end if - - call get_value(table, "done", self%done, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot read done flag in TOML table') - return - end if + call get_value(table, "done", self%done, error, 'dependency_node_t') + if (allocated(error)) return + call get_value(table, "update", self%update, error, 'dependency_node_t') + if (allocated(error)) return + call get_value(table, "cached", self%cached, error, 'dependency_node_t') + if (allocated(error)) return call get_value(table, "proj-dir", self%proj_dir) call get_value(table, "revision", self%revision) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index fe2bae7b48..ba3bc62749 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -69,6 +69,13 @@ module fpm_toml module procedure set_string_type end interface set_string + !> get_value: fpm interface + interface get_value + module procedure get_logical + module procedure get_integer + module procedure get_integer_64 + end interface get_value + abstract interface @@ -549,6 +556,92 @@ subroutine add_table_fpm(table, key, ptr, error, whereAt) end subroutine add_table_fpm + !> Function wrapper to get a logical variable from a toml table, returning an fpm error + subroutine get_logical(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + logical, intent(inout) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call get_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot get logical key <'//key//'> from TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine get_logical + + !> Function wrapper to get a default integer variable from a toml table, returning an fpm error + subroutine get_integer(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + integer, intent(inout) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call get_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot get integer key <'//key//'> from TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine get_integer + + !> Function wrapper to get a integer(int64) variable from a toml table, returning an fpm error + subroutine get_integer_64(table, key, var, error, whereAt) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> The key + character(len=*), intent(in) :: key + + !> The variable + integer(int64), intent(inout) :: var + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional description + character(len=*), intent(in), optional :: whereAt + + integer :: ierr + + call get_value(table, key, var, stat=ierr) + if (ierr/=toml_stat%success) then + call fatal_error(error,'cannot get integer(int64) key <'//key//'> from TOML table') + if (present(whereAt)) error%message = whereAt//': '//error%message + return + end if + + end subroutine get_integer_64 !> Check if table contains only keys that are part of the list. If a key is !> found that is not part of the list, an error is allocated. diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 187289c9dc..99fda31e30 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -1215,27 +1215,14 @@ subroutine load_from_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr - call get_value(table, "ar", self%ar) - call get_value(table, "use-response-file", self%use_response_file, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error getting use_response_file from TOML') - return - end if - - call get_value(table, "echo", self%echo, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error getting echo from TOML') - return - end if - - call get_value(table, "verbose", self%verbose, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'archiver_t: error getting verbose from TOML') - return - end if + call get_value(table, "use-response-file", self%use_response_file, error, 'archiver_t') + if (allocated(error)) return + call get_value(table, "echo", self%echo, error, 'archiver_t') + if (allocated(error)) return + call get_value(table, "verbose", self%verbose, error, 'archiver_t') + if (allocated(error)) return end subroutine load_from_toml @@ -1307,29 +1294,15 @@ subroutine compiler_load(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr - - call get_value(table, "id", self%id, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'compiler_t: error getting id from TOML') - return - end if - + call get_value(table, "id", self%id, error, 'compiler_t') + if (allocated(error)) return call get_value(table, "fc", self%fc) call get_value(table, "cc", self%cc) call get_value(table, "cxx", self%cxx) - - call get_value(table, "echo", self%echo, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'compiler_t: error getting echo from TOML') - return - end if - - call get_value(table, "verbose", self%verbose, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'compiler_t: error getting verbose from TOML') - return - end if + call get_value(table, "echo", self%echo, error, 'compiler_t') + if (allocated(error)) return + call get_value(table, "verbose", self%verbose, error, 'compiler_t') + if (allocated(error)) return end subroutine compiler_load diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 4732fe48ed..e34f955246 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -558,12 +558,8 @@ subroutine srcfile_load_from_toml(self, table, error) call get_value(table, "file-name", self%file_name) call get_value(table, "exe-name", self%exe_name) - - call get_value(table, "digest", self%digest, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'srcfile_t: cannot set digest in TOML table') - return - end if + call get_value(table, "digest", self%digest, error, 'srcfile_t') + if (allocated(error)) return ! unit_scope and unit_type are saved as strings so the output is independent ! of the internal representation @@ -648,18 +644,10 @@ subroutine fft_load_from_toml(self, table, error) integer :: ierr - call get_value(table, "implicit-typing", self%implicit_typing, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fortran_features_t: cannot read implicit-typing from TOML table') - return - end if - - call get_value(table, "implicit-external", self%implicit_external, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fortran_features_t: cannot read implicit-typing from TOML table') - return - end if - + call get_value(table, "implicit-typing", self%implicit_typing, error, 'fortran_features_t') + if (allocated(error)) return + call get_value(table, "implicit-external", self%implicit_external, error, 'fortran_features_t') + if (allocated(error)) return ! Return unallocated value if not present call get_value(table, "source-form", self%source_form) @@ -785,11 +773,8 @@ subroutine package_load_from_toml(self, table, error) call get_value(table, "name", self%name) call get_value(table, "version", self%version) - call get_value(table, "module-naming", self%enforce_module_names, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'package_t: cannot get module-naming from TOML table') - return - end if + call get_value(table, "module-naming", self%enforce_module_names, error, 'package_t') + if (allocated(error)) return ! Return unallocated value if not present call get_value(table, "module-prefix", self%module_prefix%s) @@ -1076,18 +1061,10 @@ subroutine model_load_from_toml(self, table, error) if (allocated(error)) return call get_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return - - call get_value(table, "include-tests", self%include_tests, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fpm_model_t: cannot read include-tests in TOML table') - return - end if - - call get_value(table, "module-naming", self%enforce_module_names, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'fpm_model_t: cannot set module-naming in TOML table') - return - end if + call get_value(table, "include-tests", self%include_tests, error, 'fpm_model_t') + if (allocated(error)) return + call get_value(table, "module-naming", self%enforce_module_names, error, 'fpm_model_t') + if (allocated(error)) return call get_value(table, "module-prefix", self%module_prefix%s) end subroutine model_load_from_toml From 73687758d4eb6b1d02f18037003193eab621abf5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 10:53:33 +0200 Subject: [PATCH 37/80] add JSON serialization flag; keep it unactive --- fpm.toml | 2 +- src/fpm/git.f90 | 2 +- src/fpm/toml.f90 | 83 ++++++++++++++++++++++++++++++------- test/fpm_test/test_toml.f90 | 5 +-- 4 files changed, 72 insertions(+), 20 deletions(-) diff --git a/fpm.toml b/fpm.toml index e59941e417..bf45c7285a 100644 --- a/fpm.toml +++ b/fpm.toml @@ -11,7 +11,7 @@ toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f" M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git" M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" jonquil.git = "https://github.com/toml-f/jonquil" -jonquil.rev = "05d30818bb12fb877226ce284b9a3a41b971a889" +jonquil.rev = "4c27c8c1e411fa8790dffcf8c3fa7a27b6322273" [[test]] name = "cli-test" diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 471b1826fd..14d1717ecc 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -382,7 +382,7 @@ subroutine load_from_toml(self, table, error) self%descriptor = parse_descriptor(descriptor_name) if (self%descriptor==git_descriptor%error) then - call fatal_error(error,"invalid descriptor ID in TOML entry") + call fatal_error(error,"invalid descriptor ID <"//descriptor_name//"> in TOML entry") return end if diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index ba3bc62749..7c85fe83c3 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -18,6 +18,9 @@ module fpm_toml use tomlf, only: toml_table, toml_array, toml_key, toml_stat, get_value, & & set_value, toml_parse, toml_error, new_table, add_table, add_array, & & toml_serialize, len, toml_load + use tomlf_de_parser, only: parse + use jonquil, only: json_serialize, json_error, json_value, json_object, json_load + use jonquil_lexer, only: json_lexer, new_lexer_from_unit use iso_fortran_env, only: int64 implicit none private @@ -154,51 +157,69 @@ end subroutine test_serialization !> Write serializable object to a formatted Fortran unit - subroutine dump_to_unit(self, unit, error) + subroutine dump_to_unit(self, unit, error, json) !> Instance of the dependency tree class(serializable_t), intent(inout) :: self !> Formatted unit integer, intent(in) :: unit !> Error handling type(error_t), allocatable, intent(out) :: error + !> Optional JSON format requested? + logical, optional, intent(in) :: json type(toml_table) :: table + logical :: is_json + + is_json = .false.; if (present(json)) is_json = json table = toml_table() call self%dump(table, error) - write (unit, '(a)') toml_serialize(table) + if (is_json) then + + !> Deactivate JSON serialization for now + call fatal_error(error, 'JSON serialization option is not yet available') + return + + write (unit, '(a)') json_serialize(table) + else + write (unit, '(a)') toml_serialize(table) + end if call table%destroy() end subroutine dump_to_unit !> Write serializable object to file - subroutine dump_to_file(self, file, error) + subroutine dump_to_file(self, file, error, json) !> Instance of the dependency tree class(serializable_t), intent(inout) :: self !> File name character(len=*), intent(in) :: file !> Error handling type(error_t), allocatable, intent(out) :: error + !> Optional JSON format + logical, optional, intent(in) :: json integer :: unit open (file=file, newunit=unit) - call self%dump(unit, error) + call self%dump(unit, error, json) close (unit) if (allocated(error)) return end subroutine dump_to_file !> Read dependency tree from file - subroutine load_from_file(self, file, error) + subroutine load_from_file(self, file, error, json) !> Instance of the dependency tree class(serializable_t), intent(inout) :: self !> File name character(len=*), intent(in) :: file !> Error handling type(error_t), allocatable, intent(out) :: error + !> Optional JSON format + logical, optional, intent(in) :: json integer :: unit logical :: exist @@ -207,30 +228,64 @@ subroutine load_from_file(self, file, error) if (.not. exist) return open (file=file, newunit=unit) - call self%load(unit, error) + call self%load(unit, error, json) close (unit) end subroutine load_from_file !> Read dependency tree from file - subroutine load_from_unit(self, unit, error) + subroutine load_from_unit(self, unit, error, json) !> Instance of the dependency tree class(serializable_t), intent(inout) :: self !> File name integer, intent(in) :: unit !> Error handling type(error_t), allocatable, intent(out) :: error + !> Optional JSON format + logical, optional, intent(in) :: json - type(toml_error), allocatable :: parse_error + type(toml_error), allocatable :: toml_error type(toml_table), allocatable :: table + type(json_lexer) :: lexer + logical :: is_json - call toml_load(table, unit, error=parse_error) + is_json = .false.; if (present(json)) is_json = json - if (allocated(parse_error)) then - allocate (error) - call move_alloc(parse_error%message, error%message) - return - end if + if (is_json) then + + !> Deactivate JSON deserialization for now + call fatal_error(error, 'JSON deserialization option is not yet available') + return + + !> init JSON interpreter + call new_lexer_from_unit(lexer, unit, toml_error) + if (allocated(toml_error)) then + allocate (error) + call move_alloc(toml_error%message, error%message) + return + end if + + !> Parse JSON to TOML table + call parse(lexer, table, error=toml_error) + if (allocated(toml_error)) then + allocate (error) + call move_alloc(toml_error%message, error%message) + return + end if + + else + + !> use default TOML parser + call toml_load(table, unit, error=toml_error) + + if (allocated(toml_error)) then + allocate (error) + call move_alloc(toml_error%message, error%message) + return + end if + + endif + !> Read object from TOML table call self%load(table, error) if (allocated(error)) return diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index ed54db07a5..fa17b2fea3 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -404,10 +404,7 @@ subroutine dependency_tree_roundtrip(error) sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") call deps%test_serialization("full dependency tree", error) - if (allocated(error)) then - print *, error%message - stop 'catastrophic' - end if + if (allocated(error)) return ! Remove dependencies (including all them) do ii = 1, ALLOCATED_DEPS From 82a4b28a0e70750346b6b7ba0dac284bf61f10da Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 11:44:59 +0200 Subject: [PATCH 38/80] implement CLI for build, update --- src/fpm.f90 | 6 ++++++ src/fpm/cmd/update.f90 | 7 ++++++- src/fpm_command_line.f90 | 32 +++++++++++++++++++++++--------- 3 files changed, 35 insertions(+), 10 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 5247f9e58d..c44452e705 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -418,6 +418,12 @@ subroutine cmd_build(settings) call fpm_stop(1,'*cmd_build* Target error: '//error%message) end if +!> Dump model to file +if (len_trim(settings%dump)>0) then + call model%dump(trim(settings%dump),error) + if (allocated(error)) call fpm_stop(1,'*cmd_build* Model dump error: '//error%message) +endif + if(settings%list)then do i=1,size(targets) write(stderr,*) targets(i)%ptr%output_file diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index e1bcb7326c..53377b113a 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -59,6 +59,11 @@ subroutine cmd_update(settings) end do end if + if (len_trim(settings%dump)>0) then + call deps%dump(trim(settings%dump), error) + call handle_error(error) + end if + end subroutine cmd_update !> Error handling for this command @@ -66,7 +71,7 @@ subroutine handle_error(error) !> Potential error type(error_t), intent(in), optional :: error if (present(error)) then - call fpm_stop(1, error%message) + call fpm_stop(1, '*cmd_update* error: '//error%message) end if end subroutine handle_error diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 4a434deb4b..8595e89591 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -73,6 +73,7 @@ module fpm_command_line logical :: show_model=.false. logical :: build_tests=.false. logical :: prune=.true. + character(len=:),allocatable :: dump character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler character(len=:),allocatable :: cxx_compiler @@ -105,6 +106,7 @@ module fpm_command_line !> Settings for interacting and updating with project dependencies type, extends(fpm_cmd_settings) :: fpm_update_settings character(len=ibug),allocatable :: name(:) + character(len=:),allocatable :: dump logical :: fetch_only logical :: clean end type @@ -132,7 +134,7 @@ module fpm_command_line & 'test', 'runner', 'install', 'update', 'list', 'help', 'version' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & - val_profile + val_profile, val_dump ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & @@ -331,6 +333,7 @@ subroutine get_command_line_settings(cmd_settings) call set_args(common_args // compiler_args //'& & --list F & & --show-model F & + & --dump " " & & --tests F & & --',help_build,version_text) @@ -339,9 +342,14 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + + val_dump = sget('dump') + if (specified('dump') .and. val_dump=='')val_dump='fpm_model.toml' + allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & & profile=val_profile,& + & dump=val_dump,& & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & @@ -574,7 +582,7 @@ subroutine get_command_line_settings(cmd_settings) & verbose=lget('verbose') ) case('update') - call set_args(common_args // ' --fetch-only F --clean F', & + call set_args(common_args // ' --fetch-only F --clean F --dump " " ', & help_update, version_text) if( size(unnamed) > 1 )then @@ -583,8 +591,11 @@ subroutine get_command_line_settings(cmd_settings) names=[character(len=len(names)) :: ] endif + val_dump = sget('dump') + if (specified('dump') .and. val_dump=='')val_dump='fpm_dependencies.toml' + allocate(fpm_update_settings :: cmd_settings) - cmd_settings=fpm_update_settings(name=names, & + cmd_settings=fpm_update_settings(name=names, dump=val_dump, & fetch_only=lget('fetch-only'), verbose=lget('verbose'), & clean=lget('clean')) @@ -691,11 +702,11 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--dump [TOMLFILE]] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] [--dump [TOMLFILE]] ', & ' list [--list] ', & ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & @@ -812,10 +823,10 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--dump [TOMLFILE]] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--dump [TOMLFILE]] ', & ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', & ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & ' [--no-prune] [-- ARGS] ', & @@ -998,7 +1009,7 @@ subroutine set_help() ' ', & 'SYNOPSIS ', & ' fpm build [--profile PROF] [--flag FFLAGS] [--compiler COMPILER_NAME] ', & - ' [--list] [--tests] ', & + ' [--list] [--tests] [--dump [TOMLFILE]] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -1026,6 +1037,8 @@ subroutine set_help() ' --list list candidates instead of building or running them ', & ' --tests build all tests (otherwise only if needed) ', & ' --show-model show the model and exit (do not build) ', & + ' --dump [TOMLFILE] save model representation to TOMLFILE ', & + ' (default file name: model.toml) ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & ' ', & @@ -1225,7 +1238,7 @@ subroutine set_help() ' update(1) - manage project dependencies', & '', & 'SYNOPSIS', & - ' fpm update [--fetch-only] [--clean] [--verbose] [NAME(s)]', & + ' fpm update [--fetch-only] [--clean] [--verbose] [--dump [TOMLFILE]] [NAME(s)]', & '', & 'DESCRIPTION', & ' Manage and update project dependencies. If no dependency names are', & @@ -1235,6 +1248,7 @@ subroutine set_help() ' --fetch-only Only fetch dependencies, do not update existing projects', & ' --clean Do not use previous dependency cache', & ' --verbose Show additional printout', & + ' --dump [TOMLFILE] Dump updated dependency tree to a toml file (default: fpm_dependencies.toml)', & '', & 'SEE ALSO', & ' The fpm(1) home page at https://github.com/fortran-lang/fpm', & From 1899e48ab7b9c5e396c634c5a97639dfba4ba04d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 14:53:27 +0200 Subject: [PATCH 39/80] enable JSON serialization --- src/fpm/dependency.f90 | 7 ++-- src/fpm/toml.f90 | 83 ++++++++++++++++++++++++------------------ 2 files changed, 51 insertions(+), 39 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 2278b4d8d1..6b700f0835 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1516,19 +1516,20 @@ subroutine tree_load_from_toml(self, table, error) call get_value(table, "unit", self%unit, stat=ierr) if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + print *, 'unit=',self%unit,' ierr=',ierr + call fatal_error(error,'dependency_tree_t: cannot get in TOML table') return end if call get_value(table, "verbosity", self%verbosity, stat=ierr) if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + call fatal_error(error,'dependency_tree_t: cannot get in TOML table') return end if call get_value(table, "ndep", self%ndep, stat=ierr) if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot set in TOML table') + call fatal_error(error,'dependency_tree_t: cannot get in TOML table') return end if diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 7c85fe83c3..07c81cebf2 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -17,10 +17,10 @@ module fpm_toml use fpm_strings, only: string_t use tomlf, only: toml_table, toml_array, toml_key, toml_stat, get_value, & & set_value, toml_parse, toml_error, new_table, add_table, add_array, & - & toml_serialize, len, toml_load + & toml_serialize, len, toml_load, toml_value use tomlf_de_parser, only: parse - use jonquil, only: json_serialize, json_error, json_value, json_object, json_load - use jonquil_lexer, only: json_lexer, new_lexer_from_unit + use jonquil, only: json_serialize, json_error, json_value, json_object, json_load, & + cast_to_object use iso_fortran_env, only: int64 implicit none private @@ -130,28 +130,40 @@ subroutine test_serialization(self, message, error) character(len=*), intent(in) :: message type(error_t), allocatable, intent(out) :: error - integer :: iunit + integer :: iunit, ii class(serializable_t), allocatable :: copy + character(len=4), parameter :: formats(2) = ['TOML','JSON'] - open(newunit=iunit,form='formatted',status='scratch') + all_formats: do ii = 1, 2 - !> Dump to scratch file - call self%dump(iunit, error) - if (allocated(error)) return + open(newunit=iunit,form='formatted',status='scratch') - !> Load from scratch file - rewind(iunit) - allocate(copy,mold=self) - call copy%load(iunit,error) - if (allocated(error)) return - close(iunit) + !> Dump to scratch file + call self%dump(iunit, error, json=ii==2) + if (allocated(error)) then + error%message = formats(ii)//': '//error%message + return + endif + + !> Load from scratch file + rewind(iunit) + allocate(copy,mold=self) + call copy%load(iunit,error, json=ii==2) + if (allocated(error)) then + error%message = formats(ii)//': '//error%message + return + endif + close(iunit) - !> Check same - if (.not.(self==copy)) then - call fatal_error(error,'serializable object failed TOML write/reread test: '//trim(message)) - return - end if - deallocate(copy) + !> Check same + if (.not.(self==copy)) then + call fatal_error(error,'serializable object failed '//formats(ii)//& + ' write/reread test: '//trim(message)) + return + end if + deallocate(copy) + + end do all_formats end subroutine test_serialization @@ -177,9 +189,9 @@ subroutine dump_to_unit(self, unit, error, json) if (is_json) then - !> Deactivate JSON serialization for now - call fatal_error(error, 'JSON serialization option is not yet available') - return +! !> Deactivate JSON serialization for now +! call fatal_error(error, 'JSON serialization option is not yet available') +! return write (unit, '(a)') json_serialize(table) else @@ -245,33 +257,31 @@ subroutine load_from_unit(self, unit, error, json) type(toml_error), allocatable :: toml_error type(toml_table), allocatable :: table - type(json_lexer) :: lexer + type(toml_table), pointer :: jtable + class(toml_value), allocatable :: object logical :: is_json is_json = .false.; if (present(json)) is_json = json if (is_json) then - !> Deactivate JSON deserialization for now - call fatal_error(error, 'JSON deserialization option is not yet available') - return - !> init JSON interpreter - call new_lexer_from_unit(lexer, unit, toml_error) + call json_load(object, unit, error=toml_error) if (allocated(toml_error)) then allocate (error) call move_alloc(toml_error%message, error%message) return end if - !> Parse JSON to TOML table - call parse(lexer, table, error=toml_error) - if (allocated(toml_error)) then - allocate (error) - call move_alloc(toml_error%message, error%message) + jtable => cast_to_object(object) + if (.not.associated(jtable)) then + call fatal_error(error,'cannot initialize JSON table ') return end if + !> Read object from TOML table + call self%load(jtable, error) + else !> use default TOML parser @@ -283,10 +293,11 @@ subroutine load_from_unit(self, unit, error, json) return end if + !> Read object from TOML table + call self%load(table, error) + endif - !> Read object from TOML table - call self%load(table, error) if (allocated(error)) return end subroutine load_from_unit From 1b6c795cba438767ad04108dec45c57c0ee0b1f7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 15:01:51 +0200 Subject: [PATCH 40/80] `--dump` option: choose JSON or TOML based on filename extension --- src/fpm.f90 | 3 ++- src/fpm/cmd/update.f90 | 3 ++- src/fpm/toml.f90 | 19 +++++++++++++++++-- 3 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index c44452e705..2cb265cc3b 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -21,6 +21,7 @@ module fpm FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t use fpm_error, only : error_t, fatal_error, fpm_stop +use fpm_toml, only: name_is_json use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -420,7 +421,7 @@ subroutine cmd_build(settings) !> Dump model to file if (len_trim(settings%dump)>0) then - call model%dump(trim(settings%dump),error) + call model%dump(trim(settings%dump),error,json=name_is_json(trim(settings%dump))) if (allocated(error)) call fpm_stop(1,'*cmd_build* Model dump error: '//error%message) endif diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index 53377b113a..11ca717441 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -4,6 +4,7 @@ module fpm_cmd_update use fpm_error, only : error_t, fpm_stop use fpm_filesystem, only : exists, mkdir, join_path, delete_file, filewrite use fpm_manifest, only : package_config_t, get_package_data + use fpm_toml, only: name_is_json implicit none private public :: cmd_update @@ -60,7 +61,7 @@ subroutine cmd_update(settings) end if if (len_trim(settings%dump)>0) then - call deps%dump(trim(settings%dump), error) + call deps%dump(trim(settings%dump), error, json=name_is_json(trim(settings%dump))) call handle_error(error) end if diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 07c81cebf2..5a1508669b 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -14,7 +14,7 @@ !> [TOML-Fortran](https://toml-f.github.io/toml-f) developer pages. module fpm_toml use fpm_error, only: error_t, fatal_error, file_not_found_error - use fpm_strings, only: string_t + use fpm_strings, only: string_t, str_ends_with, lower use tomlf, only: toml_table, toml_array, toml_key, toml_stat, get_value, & & set_value, toml_parse, toml_error, new_table, add_table, add_array, & & toml_serialize, len, toml_load, toml_value @@ -27,7 +27,8 @@ module fpm_toml public :: read_package_file, toml_table, toml_array, toml_key, toml_stat, & get_value, set_value, get_list, new_table, add_table, add_array, len, & - toml_error, toml_serialize, toml_load, check_keys, set_list, set_string + toml_error, toml_serialize, toml_load, check_keys, set_list, set_string, & + name_is_json !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON type, abstract, public :: serializable_t @@ -754,4 +755,18 @@ subroutine check_keys(table, valid_keys, error) end subroutine check_keys + !> Choose between JSON or TOML based on a file name + logical function name_is_json(filename) + character(*), intent(in) :: filename + + character(*), parameter :: json_identifier = ".json" + + name_is_json = .false. + + if (len_trim(filename) Date: Thu, 13 Apr 2023 15:29:31 +0200 Subject: [PATCH 41/80] update CLI help to JSON/TOML choice --- src/fpm_command_line.f90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 565eb2661c..791dbe5645 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -702,11 +702,11 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] [--dump [TOMLFILE]] ', & + ' [--tests] [--no-prune] [--dump [FILENAME]] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] [--dump [TOMLFILE]] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] [--dump [FILENAME]] ', & ' list [--list] ', & ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & @@ -823,10 +823,10 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] [--no-prune] [--dump [TOMLFILE]] ', & + ' [--tests] [--no-prune] [--dump [FILENAME]] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] [--dump [TOMLFILE]] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--dump [FILENAME]] ', & ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', & ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & ' [--no-prune] [-- ARGS] ', & @@ -1009,7 +1009,7 @@ subroutine set_help() ' ', & 'SYNOPSIS ', & ' fpm build [--profile PROF] [--flag FFLAGS] [--compiler COMPILER_NAME] ', & - ' [--list] [--tests] [--dump [TOMLFILE]] ', & + ' [--list] [--tests] [--dump [FILENAME]] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -1037,7 +1037,8 @@ subroutine set_help() ' --list list candidates instead of building or running them ', & ' --tests build all tests (otherwise only if needed) ', & ' --show-model show the model and exit (do not build) ', & - ' --dump [TOMLFILE] save model representation to TOMLFILE ', & + ' --dump [FILENAME] save model representation to file. use JSON format ', & + ' if file name is *.json; use TOML format otherwise ', & ' (default file name: model.toml) ', & ' --help print this help and exit ', & ' --version print program version information and exit ', & @@ -1238,7 +1239,7 @@ subroutine set_help() ' update(1) - manage project dependencies', & '', & 'SYNOPSIS', & - ' fpm update [--fetch-only] [--clean] [--verbose] [--dump [TOMLFILE]] [NAME(s)]', & + ' fpm update [--fetch-only] [--clean] [--verbose] [--dump [FILENAME]] [NAME(s)]', & '', & 'DESCRIPTION', & ' Manage and update project dependencies. If no dependency names are', & @@ -1248,7 +1249,9 @@ subroutine set_help() ' --fetch-only Only fetch dependencies, do not update existing projects', & ' --clean Do not use previous dependency cache', & ' --verbose Show additional printout', & - ' --dump [TOMLFILE] Dump updated dependency tree to a toml file (default: fpm_dependencies.toml)', & + ' --dump [FILENAME] Dump updated dependency tree to file. use JSON format ', & + ' if file name is *.json; use TOML format otherwise ', & + ' (default file name: fpm_dependencies.toml) ', & '', & 'SEE ALSO', & ' The fpm(1) home page at https://github.com/fortran-lang/fpm', & From 7b4a153d65dd134334c03cfcb13c06b86e74e553 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 13 Apr 2023 15:43:51 +0200 Subject: [PATCH 42/80] standardize some more toml interfaces --- src/fpm/dependency.f90 | 76 ++++++++++-------------------------------- 1 file changed, 18 insertions(+), 58 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 6b700f0835..e0485a068e 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1293,46 +1293,19 @@ subroutine node_dump_to_toml(self, table, error) if (allocated(error)) return if (allocated(self%version)) then - call set_value(table, "version", self%version%s(), ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set version in TOML table') - return - end if + call set_string(table, "version", self%version%s(), error,'dependency_node_t') + if (allocated(error)) return endif - - if (allocated(self%proj_dir)) then - call set_value(table, "proj-dir", self%proj_dir, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set proj_dir in TOML table') - return - end if - endif - - if (allocated(self%revision)) then - call set_value(table, "revision", self%revision, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set revision in TOML table') - return - end if - endif - - call set_value(table, "done", self%done, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set done in TOML table') - return - end if - - call set_value(table, "update", self%update, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set update in TOML table') - return - end if - - call set_value(table, "cached", self%cached, ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_node_t: cannot set cached in TOML table') - return - end if + call set_string(table, "proj-dir", self%proj_dir, error, 'dependency_node_t') + if (allocated(error)) return + call set_string(table, "revision", self%revision, error, 'dependency_node_t') + if (allocated(error)) return + call set_value(table, "done", self%done, error, 'dependency_node_t') + if (allocated(error)) return + call set_value(table, "update", self%update, error, 'dependency_node_t') + if (allocated(error)) return + call set_value(table, "cached", self%cached, error, 'dependency_node_t') + if (allocated(error)) return end subroutine node_dump_to_toml @@ -1514,25 +1487,12 @@ subroutine tree_load_from_toml(self, table, error) call table%get_keys(keys) - call get_value(table, "unit", self%unit, stat=ierr) - if (ierr/=toml_stat%success) then - print *, 'unit=',self%unit,' ierr=',ierr - call fatal_error(error,'dependency_tree_t: cannot get in TOML table') - return - end if - - call get_value(table, "verbosity", self%verbosity, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot get in TOML table') - return - end if - - call get_value(table, "ndep", self%ndep, stat=ierr) - if (ierr/=toml_stat%success) then - call fatal_error(error,'dependency_tree_t: cannot get in TOML table') - return - end if - + call get_value(table, "unit", self%unit, error, 'dependency_tree_t') + if (allocated(error)) return + call get_value(table, "verbosity", self%verbosity, error, 'dependency_tree_t') + if (allocated(error)) return + call get_value(table, "ndep", self%ndep, error, 'dependency_tree_t') + if (allocated(error)) return call get_value(table, "dep-dir", self%dep_dir) call get_value(table, "cache", self%cache) From a381863805c0748fe2edb52620756da76d22619c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 02:30:51 -0500 Subject: [PATCH 43/80] set testfile to readwrite --- src/fpm/toml.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 5a1508669b..bf8997fdf8 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -137,7 +137,7 @@ subroutine test_serialization(self, message, error) all_formats: do ii = 1, 2 - open(newunit=iunit,form='formatted',status='scratch') + open(newunit=iunit,form='formatted',action='readwrite',status='scratch') !> Dump to scratch file call self%dump(iunit, error, json=ii==2) From 986d079fe83c299ca2b950bf9a381df2821d027b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 02:39:45 -0500 Subject: [PATCH 44/80] do not use `scratch` units --- src/fpm/toml.f90 | 12 +++++++++--- test/fpm_test/test_package_dependencies.f90 | 6 ++++-- test/fpm_test/test_toml.f90 | 11 ++++++----- 3 files changed, 19 insertions(+), 10 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index bf8997fdf8..16a1f26e3a 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -22,6 +22,7 @@ module fpm_toml use jonquil, only: json_serialize, json_error, json_value, json_object, json_load, & cast_to_object use iso_fortran_env, only: int64 + use fpm_filesystem, only: get_temp_filename implicit none private @@ -133,11 +134,14 @@ subroutine test_serialization(self, message, error) integer :: iunit, ii class(serializable_t), allocatable :: copy + character(len=:), allocatable :: filename character(len=4), parameter :: formats(2) = ['TOML','JSON'] all_formats: do ii = 1, 2 - open(newunit=iunit,form='formatted',action='readwrite',status='scratch') + filename = get_temp_filename() + + open(newunit=iunit,file=filename,form='formatted',action='write') !> Dump to scratch file call self%dump(iunit, error, json=ii==2) @@ -145,16 +149,18 @@ subroutine test_serialization(self, message, error) error%message = formats(ii)//': '//error%message return endif + close(iunit) !> Load from scratch file - rewind(iunit) + open(newunit=iunit,file=filename,form='formatted',action='read') allocate(copy,mold=self) call copy%load(iunit,error, json=ii==2) if (allocated(error)) then error%message = formats(ii)//': '//error%message return endif - close(iunit) + + close(iunit,status='delete') !> Check same if (.not.(self==copy)) then diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 425e124dd4..3d2cc50663 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -89,6 +89,7 @@ subroutine test_cache_dump_load(error) type(dependency_tree_t) :: deps type(dependency_config_t) :: dep + character(len=:), allocatable :: filename integer :: unit call new_dependency_tree(deps) @@ -104,7 +105,8 @@ subroutine test_cache_dump_load(error) dep%path = "fpm-tmp3-dir" call new_dependency_node(deps%dep(3), dep, proj_dir=dep%path) - open (newunit=unit, status='scratch') + filename = get_temp_filename() + open (newunit=unit, file=filename, action='readwrite', form='formatted') call deps%dump_cache(unit, error) if (.not. allocated(error)) then rewind (unit) @@ -112,7 +114,7 @@ subroutine test_cache_dump_load(error) call new_dependency_tree(deps) call resize(deps%dep, 2) call deps%load_cache(unit, error) - close (unit) + close (unit,status='delete') end if if (allocated(error)) return diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index fa17b2fea3..5280611c8d 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -1075,18 +1075,19 @@ subroutine string_to_toml(string, table) type(toml_table), allocatable, intent(out) :: table integer :: iunit + character(len=:), allocatable :: filename - ! Write - open(newunit=iunit,form='formatted',status='scratch',action='readwrite') + filename = get_temp_filename() !> Dump to scratch file + open(newunit=iunit,file=filename,form='formatted',action='write') write(iunit,*) string + close(iunit) !> Load from scratch file - rewind(iunit) + open(newunit=iunit,file=filename,form='formatted',action='read') call toml_load(table, iunit) - - close(iunit) + close(iunit,status='delete') end subroutine string_to_toml From df1128aba644e9ee8ba577ddab51fbc557cd2ce3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 02:55:45 -0500 Subject: [PATCH 45/80] CI Windows bug -> load JSON from string --- src/fpm/toml.f90 | 59 ++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 57 insertions(+), 2 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 16a1f26e3a..c7ac5d68c9 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -19,7 +19,9 @@ module fpm_toml & set_value, toml_parse, toml_error, new_table, add_table, add_array, & & toml_serialize, len, toml_load, toml_value use tomlf_de_parser, only: parse - use jonquil, only: json_serialize, json_error, json_value, json_object, json_load, & + use tomlf_constants, only: TOML_NEWLINE + use tomlf_utils, only: read_whole_line + use jonquil, only: json_serialize, json_error, json_value, json_object, json_loads, & cast_to_object use iso_fortran_env, only: int64 use fpm_filesystem, only: get_temp_filename @@ -266,14 +268,22 @@ subroutine load_from_unit(self, unit, error, json) type(toml_table), allocatable :: table type(toml_table), pointer :: jtable class(toml_value), allocatable :: object + character(len=:), allocatable :: unit_string logical :: is_json is_json = .false.; if (present(json)) is_json = json if (is_json) then + !> Bypass gfortran+Windows issue in Jonquil + call read_whole_unit(unit_string, unit, error) + if (allocated(error)) return + + !> Add a few spaces + unit_string = unit_string // repeat(' ',10) + !> init JSON interpreter - call json_load(object, unit, error=toml_error) + call json_loads(object, unit_string, error=toml_error) if (allocated(toml_error)) then allocate (error) call move_alloc(toml_error%message, error%message) @@ -309,6 +319,51 @@ subroutine load_from_unit(self, unit, error, json) end subroutine load_from_unit + !> Create a new instance of a lexer by reading from a unit. + !> + !> Currently, only sequential access units can be processed by this constructor. + subroutine read_whole_unit(string, iunit, error) + !> Whole file string + character(len=:), allocatable, intent(out) :: string + !> Unit to read from + integer, intent(in) :: iunit + !> Error code + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: source, line + integer, parameter :: bufsize = 512 + character(len=bufsize) :: filename, mode + integer :: stat + + inquire(unit=iunit, access=mode, name=filename) + select case(trim(mode)) + case default + stat = 1 + call fatal_error(error, "Failed to read from unit: unit is not sequential") + return + + case("sequential", "SEQUENTIAL") + allocate(character(0) :: source) + do + call read_whole_line(iunit, line, stat) + if (stat > 0) exit + source = source // line // TOML_NEWLINE + if (stat < 0) then + if (is_iostat_end(stat)) stat = 0 + exit + end if + end do + end select + + !> Pass to output + allocate(character(len=len(source)) :: string) + string(1:len(source)) = source(1:len(source)) + + if (stat /= 0) then + call fatal_error(error, "Failed to read from unit") + end if + end subroutine read_whole_unit + !> Process the configuration file to a TOML data structure subroutine read_package_file(table, manifest, error) From 946aab18a5a5dd68e0cdb433a86aa49c9e623219 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:04:57 -0500 Subject: [PATCH 46/80] temporary: output ASCII sequence --- src/fpm/toml.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index c7ac5d68c9..82f61b61a4 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -270,6 +270,7 @@ subroutine load_from_unit(self, unit, error, json) class(toml_value), allocatable :: object character(len=:), allocatable :: unit_string logical :: is_json + integer :: i is_json = .false.; if (present(json)) is_json = json @@ -280,7 +281,9 @@ subroutine load_from_unit(self, unit, error, json) if (allocated(error)) return !> Add a few spaces - unit_string = unit_string // repeat(' ',10) +! unit_string = unit_string // repeat(' ',10) + + print "(a,*(1x,i0))", 'input string: ',(iachar(unit_string(i:i)),i=1,len(unit_string)) !> init JSON interpreter call json_loads(object, unit_string, error=toml_error) @@ -347,7 +350,7 @@ subroutine read_whole_unit(string, iunit, error) do call read_whole_line(iunit, line, stat) if (stat > 0) exit - source = source // line // TOML_NEWLINE + source = source // line // new_line(TOML_NEWLINE) if (stat < 0) then if (is_iostat_end(stat)) stat = 0 exit From c415327d0e3427abb302051ba9c4635a71adf6a3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:13:01 -0500 Subject: [PATCH 47/80] temporary: echo compiler version --- .github/workflows/CI.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 297fe11514..dc48b801d9 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -155,6 +155,7 @@ jobs: ${{ env.FPM }} run ${{ matrix.release-flags }} ${{ env.FPM }} run ${{ matrix.release-flags }} -- --version ${{ env.FPM }} run ${{ matrix.release-flags }} -- --help + gfortran --version - name: Test Fortran fpm shell: bash From 4c0a79dba0e6422bec1614e4f4f89592b8e3710f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:16:56 -0500 Subject: [PATCH 48/80] gfortran version on bootstrap --- .github/workflows/CI.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index dc48b801d9..dc4fb815e6 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -102,6 +102,7 @@ jobs: ${{ env.BOOTSTRAP }} run ${{ env.BOOTSTRAP }} run -- --version ${{ env.BOOTSTRAP }} run -- --help + gfortran --version - name: Test Fortran fpm (bootstrap) shell: bash @@ -155,7 +156,6 @@ jobs: ${{ env.FPM }} run ${{ matrix.release-flags }} ${{ env.FPM }} run ${{ matrix.release-flags }} -- --version ${{ env.FPM }} run ${{ matrix.release-flags }} -- --help - gfortran --version - name: Test Fortran fpm shell: bash From 2c494ed0f98eeb50c83e4e9cb81c330bbd1fd339 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:26:12 -0500 Subject: [PATCH 49/80] update mingW gfortran to 10.4.0 --- .github/workflows/CI.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index dc4fb815e6..1cfa2f28bd 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -77,7 +77,7 @@ jobs: Expand-Archive mingw-w64.zip echo "$pwd\mingw-w64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append env: - GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/9.4.0-9.0.0-msvcrt-r2/winlibs-x86_64-posix-seh-gcc-9.4.0-mingw-w64-9.0.0-r2.zip" + GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/10.4.0-10.0.0-msvcrt-r1/winlibs-x86_64-posix-seh-gcc-10.4.0-mingw-w64msvcrt-10.0.0-r1.zip" # Phase 1: Bootstrap fpm with existing version - name: Install fpm From 0477230397a3cf9c98b59dc4ccba1349077fabad Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:50:34 -0500 Subject: [PATCH 50/80] Revert "update mingW gfortran to 10.4.0" This reverts commit 2c494ed0f98eeb50c83e4e9cb81c330bbd1fd339. --- .github/workflows/CI.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 1cfa2f28bd..dc4fb815e6 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -77,7 +77,7 @@ jobs: Expand-Archive mingw-w64.zip echo "$pwd\mingw-w64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append env: - GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/10.4.0-10.0.0-msvcrt-r1/winlibs-x86_64-posix-seh-gcc-10.4.0-mingw-w64msvcrt-10.0.0-r1.zip" + GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/9.4.0-9.0.0-msvcrt-r2/winlibs-x86_64-posix-seh-gcc-9.4.0-mingw-w64-9.0.0-r2.zip" # Phase 1: Bootstrap fpm with existing version - name: Install fpm From c01e85e0c8462a0162a83d067f62ca40d6bcf928 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:50:49 -0500 Subject: [PATCH 51/80] Revert "gfortran version on bootstrap" This reverts commit 4c0a79dba0e6422bec1614e4f4f89592b8e3710f. --- .github/workflows/CI.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index dc4fb815e6..dc48b801d9 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -102,7 +102,6 @@ jobs: ${{ env.BOOTSTRAP }} run ${{ env.BOOTSTRAP }} run -- --version ${{ env.BOOTSTRAP }} run -- --help - gfortran --version - name: Test Fortran fpm (bootstrap) shell: bash @@ -156,6 +155,7 @@ jobs: ${{ env.FPM }} run ${{ matrix.release-flags }} ${{ env.FPM }} run ${{ matrix.release-flags }} -- --version ${{ env.FPM }} run ${{ matrix.release-flags }} -- --help + gfortran --version - name: Test Fortran fpm shell: bash From 048a1db3a136f72ba30df71e2a39fea07e0a9c9b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:50:53 -0500 Subject: [PATCH 52/80] Revert "temporary: echo compiler version" This reverts commit c415327d0e3427abb302051ba9c4635a71adf6a3. --- .github/workflows/CI.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index dc48b801d9..297fe11514 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -155,7 +155,6 @@ jobs: ${{ env.FPM }} run ${{ matrix.release-flags }} ${{ env.FPM }} run ${{ matrix.release-flags }} -- --version ${{ env.FPM }} run ${{ matrix.release-flags }} -- --help - gfortran --version - name: Test Fortran fpm shell: bash From 5ed2dc4d0e56297855dda5bf1ca95a3162d7f70e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:50:57 -0500 Subject: [PATCH 53/80] Revert "temporary: output ASCII sequence" This reverts commit 946aab18a5a5dd68e0cdb433a86aa49c9e623219. --- src/fpm/toml.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 82f61b61a4..c7ac5d68c9 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -270,7 +270,6 @@ subroutine load_from_unit(self, unit, error, json) class(toml_value), allocatable :: object character(len=:), allocatable :: unit_string logical :: is_json - integer :: i is_json = .false.; if (present(json)) is_json = json @@ -281,9 +280,7 @@ subroutine load_from_unit(self, unit, error, json) if (allocated(error)) return !> Add a few spaces -! unit_string = unit_string // repeat(' ',10) - - print "(a,*(1x,i0))", 'input string: ',(iachar(unit_string(i:i)),i=1,len(unit_string)) + unit_string = unit_string // repeat(' ',10) !> init JSON interpreter call json_loads(object, unit_string, error=toml_error) @@ -350,7 +347,7 @@ subroutine read_whole_unit(string, iunit, error) do call read_whole_line(iunit, line, stat) if (stat > 0) exit - source = source // line // new_line(TOML_NEWLINE) + source = source // line // TOML_NEWLINE if (stat < 0) then if (is_iostat_end(stat)) stat = 0 exit From b1497f9e36972fb50799493fc862e27454ecfeed Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:51:01 -0500 Subject: [PATCH 54/80] Revert "CI Windows bug -> load JSON from string" This reverts commit df1128aba644e9ee8ba577ddab51fbc557cd2ce3. --- src/fpm/toml.f90 | 59 ++---------------------------------------------- 1 file changed, 2 insertions(+), 57 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index c7ac5d68c9..16a1f26e3a 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -19,9 +19,7 @@ module fpm_toml & set_value, toml_parse, toml_error, new_table, add_table, add_array, & & toml_serialize, len, toml_load, toml_value use tomlf_de_parser, only: parse - use tomlf_constants, only: TOML_NEWLINE - use tomlf_utils, only: read_whole_line - use jonquil, only: json_serialize, json_error, json_value, json_object, json_loads, & + use jonquil, only: json_serialize, json_error, json_value, json_object, json_load, & cast_to_object use iso_fortran_env, only: int64 use fpm_filesystem, only: get_temp_filename @@ -268,22 +266,14 @@ subroutine load_from_unit(self, unit, error, json) type(toml_table), allocatable :: table type(toml_table), pointer :: jtable class(toml_value), allocatable :: object - character(len=:), allocatable :: unit_string logical :: is_json is_json = .false.; if (present(json)) is_json = json if (is_json) then - !> Bypass gfortran+Windows issue in Jonquil - call read_whole_unit(unit_string, unit, error) - if (allocated(error)) return - - !> Add a few spaces - unit_string = unit_string // repeat(' ',10) - !> init JSON interpreter - call json_loads(object, unit_string, error=toml_error) + call json_load(object, unit, error=toml_error) if (allocated(toml_error)) then allocate (error) call move_alloc(toml_error%message, error%message) @@ -319,51 +309,6 @@ subroutine load_from_unit(self, unit, error, json) end subroutine load_from_unit - !> Create a new instance of a lexer by reading from a unit. - !> - !> Currently, only sequential access units can be processed by this constructor. - subroutine read_whole_unit(string, iunit, error) - !> Whole file string - character(len=:), allocatable, intent(out) :: string - !> Unit to read from - integer, intent(in) :: iunit - !> Error code - type(error_t), allocatable, intent(out) :: error - - character(len=:), allocatable :: source, line - integer, parameter :: bufsize = 512 - character(len=bufsize) :: filename, mode - integer :: stat - - inquire(unit=iunit, access=mode, name=filename) - select case(trim(mode)) - case default - stat = 1 - call fatal_error(error, "Failed to read from unit: unit is not sequential") - return - - case("sequential", "SEQUENTIAL") - allocate(character(0) :: source) - do - call read_whole_line(iunit, line, stat) - if (stat > 0) exit - source = source // line // TOML_NEWLINE - if (stat < 0) then - if (is_iostat_end(stat)) stat = 0 - exit - end if - end do - end select - - !> Pass to output - allocate(character(len=len(source)) :: string) - string(1:len(source)) = source(1:len(source)) - - if (stat /= 0) then - call fatal_error(error, "Failed to read from unit") - end if - end subroutine read_whole_unit - !> Process the configuration file to a TOML data structure subroutine read_package_file(table, manifest, error) From 47e8f1b5c2a5bb9c6260a62faddffc6e69be4418 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Apr 2023 03:51:04 -0500 Subject: [PATCH 55/80] Revert "do not use `scratch` units" This reverts commit 986d079fe83c299ca2b950bf9a381df2821d027b. --- src/fpm/toml.f90 | 12 +++--------- test/fpm_test/test_package_dependencies.f90 | 6 ++---- test/fpm_test/test_toml.f90 | 11 +++++------ 3 files changed, 10 insertions(+), 19 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 16a1f26e3a..bf8997fdf8 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -22,7 +22,6 @@ module fpm_toml use jonquil, only: json_serialize, json_error, json_value, json_object, json_load, & cast_to_object use iso_fortran_env, only: int64 - use fpm_filesystem, only: get_temp_filename implicit none private @@ -134,14 +133,11 @@ subroutine test_serialization(self, message, error) integer :: iunit, ii class(serializable_t), allocatable :: copy - character(len=:), allocatable :: filename character(len=4), parameter :: formats(2) = ['TOML','JSON'] all_formats: do ii = 1, 2 - filename = get_temp_filename() - - open(newunit=iunit,file=filename,form='formatted',action='write') + open(newunit=iunit,form='formatted',action='readwrite',status='scratch') !> Dump to scratch file call self%dump(iunit, error, json=ii==2) @@ -149,18 +145,16 @@ subroutine test_serialization(self, message, error) error%message = formats(ii)//': '//error%message return endif - close(iunit) !> Load from scratch file - open(newunit=iunit,file=filename,form='formatted',action='read') + rewind(iunit) allocate(copy,mold=self) call copy%load(iunit,error, json=ii==2) if (allocated(error)) then error%message = formats(ii)//': '//error%message return endif - - close(iunit,status='delete') + close(iunit) !> Check same if (.not.(self==copy)) then diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 3d2cc50663..425e124dd4 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -89,7 +89,6 @@ subroutine test_cache_dump_load(error) type(dependency_tree_t) :: deps type(dependency_config_t) :: dep - character(len=:), allocatable :: filename integer :: unit call new_dependency_tree(deps) @@ -105,8 +104,7 @@ subroutine test_cache_dump_load(error) dep%path = "fpm-tmp3-dir" call new_dependency_node(deps%dep(3), dep, proj_dir=dep%path) - filename = get_temp_filename() - open (newunit=unit, file=filename, action='readwrite', form='formatted') + open (newunit=unit, status='scratch') call deps%dump_cache(unit, error) if (.not. allocated(error)) then rewind (unit) @@ -114,7 +112,7 @@ subroutine test_cache_dump_load(error) call new_dependency_tree(deps) call resize(deps%dep, 2) call deps%load_cache(unit, error) - close (unit,status='delete') + close (unit) end if if (allocated(error)) return diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 5280611c8d..fa17b2fea3 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -1075,19 +1075,18 @@ subroutine string_to_toml(string, table) type(toml_table), allocatable, intent(out) :: table integer :: iunit - character(len=:), allocatable :: filename - filename = get_temp_filename() + ! Write + open(newunit=iunit,form='formatted',status='scratch',action='readwrite') !> Dump to scratch file - open(newunit=iunit,file=filename,form='formatted',action='write') write(iunit,*) string - close(iunit) !> Load from scratch file - open(newunit=iunit,file=filename,form='formatted',action='read') + rewind(iunit) call toml_load(table, iunit) - close(iunit,status='delete') + + close(iunit) end subroutine string_to_toml From 3e53f8547383684e8fd65f6bfc0280c3b6361af1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 13:28:08 +0200 Subject: [PATCH 56/80] `build_config_t`: make `serializable_t` and test --- src/fpm/manifest/build.f90 | 126 ++++++++++++++++++++++++++++++-- test/fpm_test/test_manifest.f90 | 10 +++ 2 files changed, 130 insertions(+), 6 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 537fd3dd3a..4c743927a9 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -11,24 +11,25 @@ !>``` module fpm_manifest_build use fpm_error, only : error_t, syntax_error, fatal_error - use fpm_strings, only : string_t, len_trim, is_valid_module_prefix - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list + use fpm_strings, only : string_t, len_trim, is_valid_module_prefix, operator(==) + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, & + set_value, set_string, set_list implicit none private public :: build_config_t, new_build_config !> Configuration data for build - type :: build_config_t + type, extends(serializable_t) :: build_config_t !> Automatic discovery of executables - logical :: auto_executables + logical :: auto_executables = .true. !> Automatic discovery of examples - logical :: auto_examples + logical :: auto_examples = .true. !> Automatic discovery of tests - logical :: auto_tests + logical :: auto_tests = .true. !> Enforcing of package module names logical :: module_naming = .false. @@ -45,8 +46,15 @@ module fpm_manifest_build !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => build_conf_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type build_config_t + character(*), parameter, private :: class_name = 'build_config_t' + contains @@ -211,4 +219,110 @@ subroutine info(self, unit, verbosity) end subroutine info + !> Check that two dependency trees are equal + logical function build_conf_is_same(this,that) + class(build_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + build_conf_is_same = .false. + + select type (other=>that) + type is (build_config_t) + + if (this%auto_executables.neqv.other%auto_executables) return + if (this%auto_examples.neqv.other%auto_examples) return + if (this%auto_tests.neqv.other%auto_tests) return + if (this%module_naming.neqv.other%module_naming) return + if (.not.this%module_prefix==other%module_prefix) return + if (.not.this%link==other%link) return + if (.not.this%external_modules==other%external_modules) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + build_conf_is_same = .true. + + end function build_conf_is_same + + !> Dump build config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(build_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_value(table, "auto-executables", self%auto_executables, error, class_name) + if (allocated(error)) return + call set_value(table, "auto-tests", self%auto_tests, error, class_name) + if (allocated(error)) return + call set_value(table, "auto-examples", self%auto_examples, error, class_name) + if (allocated(error)) return + + ! Module naming can either contain a boolean value, or the prefix + has_prefix: if (self%module_naming .and. len_trim(self%module_prefix)>0) then + call set_string(table, "module-naming", self%module_prefix, error, class_name) + else + call set_value (table, "module-naming", self%module_naming, error, class_name) + end if has_prefix + if (allocated(error)) return + + call set_list(table, "link", self%link, error) + if (allocated(error)) return + call set_list(table, "external-modules", self%external_modules, error) + if (allocated(error)) return + + end subroutine dump_to_toml + + !> Read build config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(build_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: stat + + call get_value(table, "auto-executables", self%auto_executables, error, class_name) + if (allocated(error)) return + call get_value(table, "auto-tests", self%auto_tests, error, class_name) + if (allocated(error)) return + call get_value(table, "auto-examples", self%auto_examples, error, class_name) + if (allocated(error)) return + + !> Module naming: fist, attempt boolean value first + call get_value(table, "module-naming", self%module_naming, .false., stat=stat) + if (stat == toml_stat%success) then + ! Boolean value found. Set no custom prefix. This also falls back to key not provided + self%module_prefix = string_t("") + else + !> Value found, but not a boolean. Attempt to read a prefix string + call get_value(table, "module-naming", self%module_prefix%s) + if (.not.allocated(self%module_prefix%s)) then + call syntax_error(error,"Could not read value for 'module-naming' in fpm.toml, expecting logical or a string") + return + end if + self%module_naming = .true. + end if + + call get_list(table, "link", self%link, error) + if (allocated(error)) return + call get_list(table, "external-modules", self%external_modules, error) + if (allocated(error)) return + + end subroutine load_from_toml + + end module fpm_manifest_build diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index cd2605f4e3..917fd314fd 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1206,6 +1206,11 @@ subroutine test_link_string(error) call set_value(table, "link", "z", stat=stat) call new_build_config(build, table, 'test_link_string', error) + if (allocated(error)) return + + !> Test serialization roundtrip + call build%test_serialization('test_link_string', error) + if (allocated(error)) return end subroutine test_link_string @@ -1229,6 +1234,11 @@ subroutine test_link_array(error) call set_value(children, 2, "lapack", stat=stat) call new_build_config(build, table, 'test_link_array', error) + if (allocated(error)) return + + !> Test serialization roundtrip + call build%test_serialization('test_link_string', error) + if (allocated(error)) return end subroutine test_link_array From fead5282f22965d9d6c3963417ec312427b8e6d9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 14:37:39 +0200 Subject: [PATCH 57/80] `new_build_config`: use standardized `load_from_toml` --- src/fpm/manifest/build.f90 | 56 +------------------------------------- 1 file changed, 1 insertion(+), 55 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 4c743927a9..e1835d0639 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -79,61 +79,7 @@ subroutine new_build_config(self, table, package_name, error) call check(table, package_name, 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 - - call get_value(table, "auto-examples", self%auto_examples, .true., stat=stat) - - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'auto-examples' in fpm.toml, expecting logical") - return - end if - - !> Module naming: fist, attempt boolean value first - call get_value(table, "module-naming", self%module_naming, .false., stat=stat) - - if (stat == toml_stat%success) then - - ! Boolean value found. Set no custom prefix. This also falls back to - ! key not provided - self%module_prefix = string_t("") - - else - - !> Value found, but not a boolean. Attempt to read a prefix string - call get_value(table, "module-naming", self%module_prefix%s) - - if (.not.allocated(self%module_prefix%s)) then - call syntax_error(error,"Could not read value for 'module-naming' in fpm.toml, expecting logical or a string") - return - end if - - if (.not.is_valid_module_prefix(self%module_prefix)) then - call syntax_error(error,"Invalid custom module name prefix for in fpm.toml: <"//self%module_prefix%s// & - ">, expecting a valid alphanumeric string") - return - end if - - ! Set module naming to ON - self%module_naming = .true. - - end if - - call get_list(table, "link", self%link, error) - if (allocated(error)) return - - call get_list(table, "external-modules", self%external_modules, error) + call self%load_from_toml(table, error) if (allocated(error)) return end subroutine new_build_config From 2eb9aee84f1cb50641448541c491f45d628a8b05 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 14:49:38 +0200 Subject: [PATCH 58/80] Revert "`new_build_config`: use standardized `load_from_toml`" This reverts commit fead5282f22965d9d6c3963417ec312427b8e6d9. --- src/fpm/manifest/build.f90 | 56 +++++++++++++++++++++++++++++++++++++- 1 file changed, 55 insertions(+), 1 deletion(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index e1835d0639..4c743927a9 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -79,7 +79,61 @@ subroutine new_build_config(self, table, package_name, error) call check(table, package_name, error) if (allocated(error)) return - call self%load_from_toml(table, error) + 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 + + call get_value(table, "auto-examples", self%auto_examples, .true., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'auto-examples' in fpm.toml, expecting logical") + return + end if + + !> Module naming: fist, attempt boolean value first + call get_value(table, "module-naming", self%module_naming, .false., stat=stat) + + if (stat == toml_stat%success) then + + ! Boolean value found. Set no custom prefix. This also falls back to + ! key not provided + self%module_prefix = string_t("") + + else + + !> Value found, but not a boolean. Attempt to read a prefix string + call get_value(table, "module-naming", self%module_prefix%s) + + if (.not.allocated(self%module_prefix%s)) then + call syntax_error(error,"Could not read value for 'module-naming' in fpm.toml, expecting logical or a string") + return + end if + + if (.not.is_valid_module_prefix(self%module_prefix)) then + call syntax_error(error,"Invalid custom module name prefix for in fpm.toml: <"//self%module_prefix%s// & + ">, expecting a valid alphanumeric string") + return + end if + + ! Set module naming to ON + self%module_naming = .true. + + end if + + call get_list(table, "link", self%link, error) + if (allocated(error)) return + + call get_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return end subroutine new_build_config From b120b6a4813cc0617d47499780358a67a2b69a29 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 19:18:45 +0200 Subject: [PATCH 59/80] `install_config_t`: make serializable --- src/fpm/manifest/install.f90 | 66 ++++++++++++++++++++++++++++++++++-- test/fpm_test/test_toml.f90 | 24 +++++++++++++ 2 files changed, 88 insertions(+), 2 deletions(-) diff --git a/src/fpm/manifest/install.f90 b/src/fpm/manifest/install.f90 index 6175873937..98c2ef5321 100644 --- a/src/fpm/manifest/install.f90 +++ b/src/fpm/manifest/install.f90 @@ -7,14 +7,14 @@ !>``` module fpm_manifest_install use fpm_error, only : error_t, fatal_error, syntax_error - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, set_value, serializable_t implicit none private public :: install_config_t, new_install_config !> Configuration data for installation - type :: install_config_t + type, extends(serializable_t) :: install_config_t !> Install library with this project logical :: library @@ -24,8 +24,16 @@ module fpm_manifest_install !> Print information on this instance procedure :: info + + !> Serialization interface + procedure :: serializable_is_same => install_conf_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type install_config_t + character(*), parameter :: class_name = 'install_config_t' + contains !> Create a new installation configuration from a TOML data structure @@ -105,4 +113,58 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function install_conf_same(this,that) + class(install_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + install_conf_same = .false. + + select type (other=>that) + type is (install_config_t) + if (this%library.neqv.other%library) return + class default + ! Not the same type + return + end select + + !> All checks passed! + install_conf_same = .true. + + end function install_conf_same + + !> Dump install config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(install_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_value(table, "library", self%library, error, class_name) + + end subroutine dump_to_toml + + !> Read install config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(install_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: stat + + call get_value(table, "library", self%library, error, class_name) + if (allocated(error)) return + + end subroutine load_from_toml + end module fpm_manifest_install diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index fa17b2fea3..909e6a4deb 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -7,12 +7,14 @@ module test_toml use fpm_dependency, only: dependency_node_t, destroy_dependency_node, dependency_tree_t, & & new_dependency_node, new_dependency_tree, resize use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy + use fpm_manifest_install use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & & srcfile_t use fpm_compiler, only: archiver_t, compiler_t, id_gcc + implicit none private @@ -42,6 +44,7 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-tree", dependency_tree_roundtrip), & & new_unittest("serialize-dependency-tree-invalid", dependency_tree_invalid, should_fail=.true.), & & new_unittest("serialize-dependency-tree-invalid2", dependency_tree_invalid2, should_fail=.true.), & + & new_unittest("serialize-install-config", install_config_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1142,4 +1145,25 @@ subroutine fpm_model_invalid(error) end subroutine fpm_model_invalid + subroutine install_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(install_config_t) :: install + + integer :: loop + + do loop=1,2 + + install % library = mod(loop,2)==0 + + ! Test full object + call install%test_serialization('install_config_roundtrip',error) + if (allocated(error)) return + + end do + + end subroutine install_config_roundtrip + end module test_toml From 95cd89fa8f3816e252484a69b7ab26ee4fe735d8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 19:33:46 +0200 Subject: [PATCH 60/80] serialize `fortran_config_t` --- src/fpm/manifest/fortran.f90 | 82 ++++++++++++++++++++++++++++++++++-- src/fpm/manifest/install.f90 | 1 - test/fpm_test/test_toml.f90 | 23 ++++++++++ 3 files changed, 101 insertions(+), 5 deletions(-) diff --git a/src/fpm/manifest/fortran.f90 b/src/fpm/manifest/fortran.f90 index bf76fa2e38..231191c433 100644 --- a/src/fpm/manifest/fortran.f90 +++ b/src/fpm/manifest/fortran.f90 @@ -1,25 +1,35 @@ module fpm_manifest_fortran use fpm_error, only : error_t, syntax_error, fatal_error - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string implicit none private public :: fortran_config_t, new_fortran_config !> Configuration data for Fortran - type :: fortran_config_t + type, extends(serializable_t) :: fortran_config_t !> Enable default implicit typing - logical :: implicit_typing + logical :: implicit_typing = .false. !> Enable implicit external interfaces - logical :: implicit_external + logical :: implicit_external = .false. !> Form to use for all Fortran sources character(:), allocatable :: source_form + contains + + !> Serialization interface + procedure :: serializable_is_same => fortran_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + + end type fortran_config_t + character(len=*), parameter, private :: class_name = 'fortran_config_t' + contains !> Construct a new build configuration from a TOML data structure @@ -102,4 +112,68 @@ subroutine check(table, error) end subroutine check + logical function fortran_is_same(this,that) + class(fortran_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + fortran_is_same = .false. + + select type (other=>that) + type is (fortran_config_t) + if (this%implicit_typing.neqv.other%implicit_typing) return + if (this%implicit_external.neqv.other%implicit_external) return + if (.not.allocated(this%source_form).eqv.allocated(other%source_form)) return + if (.not.this%source_form==other%source_form) return + class default + ! Not the same type + return + end select + + !> All checks passed! + fortran_is_same = .true. + + end function fortran_is_same + + !> Dump install config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(fortran_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_value(table, "implicit-typing", self%implicit_typing, error, class_name) + if (allocated(error)) return + call set_value(table, "implicit-external", self%implicit_external, error, class_name) + if (allocated(error)) return + call set_string(table, "source-form", self%source_form, error, class_name) + if (allocated(error)) return + + end subroutine dump_to_toml + + !> Read install config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(fortran_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call get_value(table, "implicit-typing", self%implicit_typing, error, class_name) + if (allocated(error)) return + call get_value(table, "implicit-external", self%implicit_external, error, class_name) + if (allocated(error)) return + call get_value(table, "source-form", self%source_form) + + end subroutine load_from_toml + + end module fpm_manifest_fortran diff --git a/src/fpm/manifest/install.f90 b/src/fpm/manifest/install.f90 index 98c2ef5321..87a0c357bd 100644 --- a/src/fpm/manifest/install.f90 +++ b/src/fpm/manifest/install.f90 @@ -24,7 +24,6 @@ module fpm_manifest_install !> Print information on this instance procedure :: info - !> Serialization interface procedure :: serializable_is_same => install_conf_same procedure :: dump_to_toml diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 909e6a4deb..28139ac9c0 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -8,6 +8,7 @@ module test_toml & new_dependency_node, new_dependency_tree, resize use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_manifest_install + use fpm_manifest_fortran use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & @@ -45,6 +46,7 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-tree-invalid", dependency_tree_invalid, should_fail=.true.), & & new_unittest("serialize-dependency-tree-invalid2", dependency_tree_invalid2, should_fail=.true.), & & new_unittest("serialize-install-config", install_config_roundtrip), & + & new_unittest("serialize-fortran-config", fortran_features_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1166,4 +1168,25 @@ subroutine install_config_roundtrip(error) end subroutine install_config_roundtrip + subroutine fortran_features_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fortran_config_t) :: fortran + + integer :: loop + + fortran%implicit_external = .true. + fortran%implicit_typing = .false. + fortran%source_form = 'free' + + call fortran%test_serialization('fortran_features_roundtrip',error) + if (allocated(error)) return + + deallocate(fortran%source_form) + call fortran%test_serialization('fortran_features_roundtrip 2',error) + + end subroutine fortran_features_roundtrip + end module test_toml From 569f8988d276aebf9000b8c1e969a5e4f0191e21 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 20:00:59 +0200 Subject: [PATCH 61/80] serialize `library_config_t` --- src/fpm/manifest/library.f90 | 78 ++++++++++++++++++++++++++++++++++-- test/fpm_test/test_toml.f90 | 27 ++++++++++++- 2 files changed, 100 insertions(+), 5 deletions(-) diff --git a/src/fpm/manifest/library.f90 b/src/fpm/manifest/library.f90 index 68ccc203ef..52e33efecb 100644 --- a/src/fpm/manifest/library.f90 +++ b/src/fpm/manifest/library.f90 @@ -10,8 +10,9 @@ !>``` module fpm_manifest_library use fpm_error, only : error_t, syntax_error - use fpm_strings, only: string_t, string_cat - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list + use fpm_strings, only: string_t, string_cat, operator(==) + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, set_value, & + set_list, set_string, get_value, get_list implicit none private @@ -19,7 +20,7 @@ module fpm_manifest_library !> Configuration meta data for a library - type :: library_config_t + type, extends(serializable_t) :: library_config_t !> Source path prefix character(len=:), allocatable :: source_dir @@ -35,8 +36,15 @@ module fpm_manifest_library !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => library_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type library_config_t + character(*), parameter, private :: class_name = 'library_config_t' + contains @@ -138,5 +146,69 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function library_is_same(this,that) + class(library_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + library_is_same = .false. + + select type (other=>that) + type is (library_config_t) + if (.not.this%include_dir==other%include_dir) return + if (.not.allocated(this%source_dir).eqv.allocated(other%source_dir)) return + if (.not.this%source_dir==other%source_dir) return + if (.not.allocated(this%build_script).eqv.allocated(other%build_script)) return + if (.not.this%build_script==other%build_script) return + class default + ! Not the same type + return + end select + + !> All checks passed! + library_is_same = .true. + + end function library_is_same + + !> Dump install config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(library_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_string(table, "source-dir", self%source_dir, error, class_name) + if (allocated(error)) return + call set_string(table, "build-script", self%build_script, error, class_name) + if (allocated(error)) return + call set_list(table, "include-dir", self%include_dir, error) + if (allocated(error)) return + + end subroutine dump_to_toml + + !> Read install config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(library_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call get_value(table, "source-dir", self%source_dir) + if (allocated(error)) return + call get_value(table, "build-script", self%build_script) + if (allocated(error)) return + call get_list(table, "include-dir", self%include_dir, error) + + end subroutine load_from_toml + end module fpm_manifest_library diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 28139ac9c0..c95f4468ee 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -9,6 +9,7 @@ module test_toml use fpm_manifest_dependency, only: dependency_config_t, dependency_destroy use fpm_manifest_install use fpm_manifest_fortran + use fpm_manifest_library use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & @@ -47,6 +48,7 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-dependency-tree-invalid2", dependency_tree_invalid2, should_fail=.true.), & & new_unittest("serialize-install-config", install_config_roundtrip), & & new_unittest("serialize-fortran-config", fortran_features_roundtrip), & + & new_unittest("serialize-library-config", library_config_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1175,8 +1177,6 @@ subroutine fortran_features_roundtrip(error) type(fortran_config_t) :: fortran - integer :: loop - fortran%implicit_external = .true. fortran%implicit_typing = .false. fortran%source_form = 'free' @@ -1189,4 +1189,27 @@ subroutine fortran_features_roundtrip(error) end subroutine fortran_features_roundtrip + subroutine library_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(library_config_t) :: lib + + lib%source_dir = 'lib' + lib%include_dir = [string_t('a'),string_t('b')] + + call lib%test_serialization('library_config: 1',error) + if (allocated(error)) return + + lib%build_script = 'install.sh' + + call lib%test_serialization('library_config: 2',error) + if (allocated(error)) return + + deallocate(lib%include_dir) + call lib%test_serialization('library_config: 3',error) + + end subroutine library_config_roundtrip + end module test_toml From 5c6dcfc3eef8101d52c3bb4c26668fe4a1c9e27e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 May 2023 20:20:54 +0200 Subject: [PATCH 62/80] serialize `executable_config_t` --- src/fpm/manifest/dependency.f90 | 41 +++++++- src/fpm/manifest/executable.f90 | 170 +++++++++++++++++++++++++++++++- test/fpm_test/test_toml.f90 | 41 ++++++++ 3 files changed, 246 insertions(+), 6 deletions(-) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index c3013178f5..b6f0e1e810 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -35,7 +35,7 @@ module fpm_manifest_dependency private public :: dependency_config_t, new_dependency, new_dependencies, manifest_has_changed, & - & dependency_destroy + & dependency_destroy, resize !> Configuration meta data for a dependency type, extends(serializable_t) :: dependency_config_t @@ -73,6 +73,10 @@ module fpm_manifest_dependency !> Common output format for writing to the command line character(len=*), parameter :: out_fmt = '("#", *(1x, g0))' + interface resize + module procedure resize_dependency_config + end interface resize + contains !> Construct a new dependency configuration from a TOML data structure @@ -438,4 +442,39 @@ subroutine load_from_toml(self, table, error) end subroutine load_from_toml + !> Reallocate a list of dependencies + pure subroutine resize_dependency_config(var, n) + !> Instance of the array to be resized + type(dependency_config_t), allocatable, intent(inout) :: var(:) + !> Dimension of the final array size + integer, intent(in), optional :: n + + type(dependency_config_t), allocatable :: tmp(:) + integer :: this_size, new_size + integer, parameter :: initial_size = 16 + + if (allocated(var)) then + this_size = size(var, 1) + call move_alloc(var, tmp) + else + this_size = initial_size + end if + + if (present(n)) then + new_size = n + else + new_size = this_size + this_size/2 + 1 + end if + + allocate (var(new_size)) + + if (allocated(tmp)) then + this_size = min(size(tmp, 1), size(var, 1)) + var(:this_size) = tmp(:this_size) + deallocate (tmp) + end if + + end subroutine resize_dependency_config + + end module fpm_manifest_dependency diff --git a/src/fpm/manifest/executable.f90 b/src/fpm/manifest/executable.f90 index 66bb0f2cb2..47c500a824 100644 --- a/src/fpm/manifest/executable.f90 +++ b/src/fpm/manifest/executable.f90 @@ -11,10 +11,11 @@ !>[executable.dependencies] !>``` module fpm_manifest_executable - use fpm_manifest_dependency, only : dependency_config_t, new_dependencies - use fpm_error, only : error_t, syntax_error, bad_name_error - use fpm_strings, only : string_t - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list + use fpm_manifest_dependency, only : dependency_config_t, new_dependencies, resize + use fpm_error, only : error_t, syntax_error, bad_name_error, fatal_error + use fpm_strings, only : string_t, operator(==) + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, add_table, & + set_string, set_list implicit none private @@ -22,7 +23,7 @@ module fpm_manifest_executable !> Configuation meta data for an executable - type :: executable_config_t + type, extends(serializable_t) :: executable_config_t !> Name of the resulting executable character(len=:), allocatable :: name @@ -44,8 +45,15 @@ module fpm_manifest_executable !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => exe_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type executable_config_t + character(*), parameter, private :: class_name = 'executable_config_t' + contains @@ -186,4 +194,156 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function exe_is_same(this,that) + class(executable_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + exe_is_same = .false. + + select type (other=>that) + type is (executable_config_t) + if (.not.this%link==other%link) return + if (.not.allocated(this%name).eqv.allocated(other%name)) return + if (.not.this%name==other%name) return + if (.not.allocated(this%source_dir).eqv.allocated(other%source_dir)) return + if (.not.this%source_dir==other%source_dir) return + if (.not.allocated(this%main).eqv.allocated(other%main)) return + if (.not.this%main==other%main) return + if (.not.allocated(this%dependency).eqv.allocated(other%dependency)) return + if (allocated(this%dependency)) then + if (.not.(size(this%dependency)==size(other%dependency))) return + do ii = 1, size(this%dependency) + if (.not.(this%dependency(ii)==other%dependency(ii))) return + end do + end if + class default + ! Not the same type + return + end select + + !> All checks passed! + exe_is_same = .true. + + end function exe_is_same + + !> Dump install config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(executable_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + integer :: ierr, ii + type(toml_table), pointer :: ptr_deps,ptr + character(27) :: unnamed + + call set_string(table, "name", self%name, error) + if (allocated(error)) return + call set_string(table, "source-dir", self%source_dir, error) + if (allocated(error)) return + call set_string(table, "main", self%main, error) + if (allocated(error)) return + + if (allocated(self%dependency)) then + + ! Create dependency table + call add_table(table, "dependencies", ptr_deps) + if (.not. associated(ptr_deps)) then + call fatal_error(error, class_name//" cannot create dependency table ") + return + end if + + do ii = 1, size(self%dependency) + associate (dep => self%dependency(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(dep%name)==0) then + write(unnamed,1) ii + call add_table(ptr_deps, trim(unnamed), ptr) + else + call add_table(ptr_deps, dep%name, ptr) + end if + if (.not. associated(ptr)) then + call fatal_error(error, class_name//" cannot create entry for dependency "//dep%name) + return + end if + call dep%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + + endif + + call set_list(table, "link", self%link, error) + if (allocated(error)) return + + 1 format('UNNAMED_DEPENDENCY_',i0) + + end subroutine dump_to_toml + + !> Read install config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(executable_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + type(toml_key), allocatable :: keys(:),dep_keys(:) + type(toml_table), pointer :: ptr_deps,ptr + integer :: ii, jj, ierr + + call table%get_keys(keys) + + call get_value(table, "name", self%name) + if (allocated(error)) return + call get_value(table, "source-dir", self%source_dir) + if (allocated(error)) return + call get_value(table, "main", self%main) + if (allocated(error)) return + call get_list(table, "link", self%link, error) + + find_deps_table: do ii = 1, size(keys) + if (keys(ii)%key=="dependencies") then + + call get_value(table, keys(ii), ptr_deps) + if (.not.associated(ptr_deps)) then + call fatal_error(error,class_name//': error retrieving dependency table from TOML table') + return + end if + + !> Read all dependencies + call ptr_deps%get_keys(dep_keys) + call resize(self%dependency, size(dep_keys)) + + do jj = 1, size(dep_keys) + + call get_value(ptr_deps, dep_keys(jj), ptr) + call self%dependency(jj)%load_from_toml(ptr, error) + if (allocated(error)) return + + end do + + exit find_deps_table + + endif + end do find_deps_table + + end subroutine load_from_toml + + end module fpm_manifest_executable diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index c95f4468ee..a76b5c9f47 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -10,6 +10,7 @@ module test_toml use fpm_manifest_install use fpm_manifest_fortran use fpm_manifest_library + use fpm_manifest_executable use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & @@ -1212,4 +1213,44 @@ subroutine library_config_roundtrip(error) end subroutine library_config_roundtrip + + subroutine executable_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(executable_config_t) :: exe + type(dependency_config_t) :: dep + + exe%name = "my_executable" + exe%source_dir = 'app' + + call exe%test_serialization('executable_config: 1',error) + if (allocated(error)) return + + exe%main = 'main_program.F90' + + call exe%test_serialization('executable_config: 2',error) + if (allocated(error)) return + + exe%link = [string_t('netcdf'),string_t('hdf5')] + call exe%test_serialization('executable_config: 3',error) + + call dependency_destroy(dep) + + dep%name = "M_CLI2" + dep%path = "~/./some/dummy/path" + dep%namespace = "urbanjost" + allocate(dep%requested_version) + call new_version(dep%requested_version, "3.2.0",error); if (allocated(error)) return + + allocate(dep%git) + dep%git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", & + sha1="7264878cdb1baff7323cc48596d829ccfe7751b8") + + allocate(exe%dependency(1),source=dep) + call exe%test_serialization('executable_config: 4',error) + + end subroutine executable_config_roundtrip + end module test_toml From 819e0ebda3504ca2190a810716f730f1278c3b3d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 17 May 2023 09:29:30 -0500 Subject: [PATCH 63/80] `preprocess_config_t`: make serializable and test --- src/fpm/manifest/fortran.f90 | 1 - src/fpm/manifest/install.f90 | 2 +- src/fpm/manifest/preprocess.f90 | 87 +++++++++++++++++++++++++++++++-- test/fpm_test/test_toml.f90 | 18 +++++++ 4 files changed, 102 insertions(+), 6 deletions(-) diff --git a/src/fpm/manifest/fortran.f90 b/src/fpm/manifest/fortran.f90 index 231191c433..083d61fe1e 100644 --- a/src/fpm/manifest/fortran.f90 +++ b/src/fpm/manifest/fortran.f90 @@ -25,7 +25,6 @@ module fpm_manifest_fortran procedure :: dump_to_toml procedure :: load_from_toml - end type fortran_config_t character(len=*), parameter, private :: class_name = 'fortran_config_t' diff --git a/src/fpm/manifest/install.f90 b/src/fpm/manifest/install.f90 index 87a0c357bd..5c0f46837f 100644 --- a/src/fpm/manifest/install.f90 +++ b/src/fpm/manifest/install.f90 @@ -31,7 +31,7 @@ module fpm_manifest_install end type install_config_t - character(*), parameter :: class_name = 'install_config_t' + character(*), parameter, private :: class_name = 'install_config_t' contains diff --git a/src/fpm/manifest/preprocess.f90 b/src/fpm/manifest/preprocess.f90 index 538652c29a..6d7df28871 100644 --- a/src/fpm/manifest/preprocess.f90 +++ b/src/fpm/manifest/preprocess.f90 @@ -12,15 +12,16 @@ module fpm_manifest_preprocess use fpm_error, only : error_t, syntax_error - use fpm_strings, only : string_t - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list + use fpm_strings, only : string_t, operator(==) + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, set_value, set_list, & + set_string implicit none private public :: preprocess_config_t, new_preprocess_config, new_preprocessors !> Configuration meta data for a preprocessor - type :: preprocess_config_t + type, extends(serializable_t) :: preprocess_config_t !> Name of the preprocessor character(len=:), allocatable :: name @@ -39,8 +40,15 @@ module fpm_manifest_preprocess !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => preprocess_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type preprocess_config_t + character(*), parameter, private :: class_name = 'preprocess_config_t' + contains !> Construct a new preprocess configuration from TOML data structure @@ -154,7 +162,7 @@ subroutine info(self, unit, verbosity) pr = 1 end if - if (pr < 1) return + if (pr < 1) return write(unit, fmt) "Preprocessor" if (allocated(self%name)) then @@ -181,4 +189,75 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function preprocess_is_same(this,that) + class(preprocess_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + preprocess_is_same = .false. + + select type (other=>that) + type is (preprocess_config_t) + if (allocated(this%name).neqv.allocated(other%name)) return + if (allocated(this%name)) then + if (.not.(this%name==other%name)) return + endif + if (.not.(this%suffixes==other%suffixes)) return + if (.not.(this%directories==other%directories)) return + if (.not.(this%macros==other%macros)) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + preprocess_is_same = .true. + + end function preprocess_is_same + + !> Dump install config to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(preprocess_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_string(table, "name", self%name, error) + if (allocated(error)) return + call set_list(table, "suffixes", self%suffixes, error) + if (allocated(error)) return + call set_list(table, "directories", self%directories, error) + if (allocated(error)) return + call set_list(table, "macros", self%macros, error) + if (allocated(error)) return + + end subroutine dump_to_toml + + !> Read install config from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(preprocess_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call get_value(table, "name", self%name) + call get_list(table, "suffixes", self%suffixes, error) + if (allocated(error)) return + call get_list(table, "directories", self%directories, error) + if (allocated(error)) return + call get_list(table, "macros", self%macros, error) + if (allocated(error)) return + + end subroutine load_from_toml + end module fpm_manifest_preprocess diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index a76b5c9f47..2a0301d2a5 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -11,6 +11,7 @@ module test_toml use fpm_manifest_fortran use fpm_manifest_library use fpm_manifest_executable + use fpm_manifest_preprocess use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & @@ -50,6 +51,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-install-config", install_config_roundtrip), & & new_unittest("serialize-fortran-config", fortran_features_roundtrip), & & new_unittest("serialize-library-config", library_config_roundtrip), & + & new_unittest("serialize-executable-config", executable_config_roundtrip), & + & new_unittest("serialize-preprocess-config", preprocess_config_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1253,4 +1256,19 @@ subroutine executable_config_roundtrip(error) end subroutine executable_config_roundtrip + + subroutine preprocess_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(preprocess_config_t) :: prep + + prep%name = "preprocessor config" + prep%macros = [string_t('Whatever'),string_t('FPM_BOOTSTRAP')] + + call prep%test_serialization('preprocess_config', error) + + end subroutine preprocess_config_roundtrip + end module test_toml From 24d9da09b1b2110b95b87d097d0bb8a03823ec5f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 14:24:05 +0200 Subject: [PATCH 64/80] serialize `file_scope_flag` and test --- src/fpm/manifest/profiles.f90 | 120 +++++++++++++++++++++++++++------- test/fpm_test/test_toml.f90 | 19 ++++++ 2 files changed, 116 insertions(+), 23 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 2e84f0c6e9..44fe65ad3a 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -43,7 +43,7 @@ !> module fpm_manifest_profile use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD @@ -53,12 +53,12 @@ module fpm_manifest_profile & info_profile, find_profile, DEFAULT_COMPILER !> Name of the default compiler - character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' + character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' integer, parameter :: OS_ALL = -1 character(len=:), allocatable :: path !> Type storing file name - file scope compiler flags pairs - type :: file_scope_flag + type, extends(serializable_t) :: file_scope_flag !> Name of the file character(len=:), allocatable :: file_name @@ -66,6 +66,13 @@ module fpm_manifest_profile !> File scope flags character(len=:), allocatable :: flags + contains + + !> Serialization interface + procedure :: serializable_is_same => file_scope_same + procedure :: dump_to_toml => file_scope_dump + procedure :: load_from_toml => file_scope_load + end type file_scope_flag !> Configuration meta data for a profile @@ -78,7 +85,7 @@ module fpm_manifest_profile !> Value repesenting OS integer :: os_type - + !> Fortran compiler flags character(len=:), allocatable :: flags @@ -110,16 +117,16 @@ module fpm_manifest_profile function new_profile(profile_name, compiler, os_type, flags, c_flags, cxx_flags, & link_time_flags, file_scope_flags, is_built_in) & & result(profile) - + !> Name of the profile character(len=*), intent(in) :: profile_name - + !> Name of the compiler character(len=*), intent(in) :: compiler - + !> Type of the OS integer, intent(in) :: os_type - + !> Fortran compiler flags character(len=*), optional, intent(in) :: flags @@ -190,7 +197,7 @@ subroutine validate_compiler_name(compiler_name, is_valid) is_valid = .false. end select end subroutine validate_compiler_name - + !> Check if os_name is a valid name of a supported OS subroutine validate_os_name(os_name, is_valid) @@ -373,10 +380,10 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof & flags, c_flags, cxx_flags, link_time_flags, file_scope_flags) profindex = profindex + 1 end subroutine get_flags - + !> Traverse operating system tables to obtain number of profiles subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -447,7 +454,7 @@ end subroutine traverse_oss_for_size !> Traverse operating system tables to obtain profiles subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, profindex, error) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -468,7 +475,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, p !> Index in the list of profiles integer, intent(inout) :: profindex - + type(toml_key), allocatable :: key_list(:) character(len=:), allocatable :: os_name, l_os_name type(toml_table), pointer :: os_node @@ -513,7 +520,7 @@ end subroutine traverse_oss !> Traverse compiler tables subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_size, profiles, profindex) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -522,10 +529,10 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si !> Table containing compiler tables type(toml_table), pointer, intent(in) :: table - + !> Error handling type(error_t), allocatable, intent(out) :: error - + !> Number of profiles in list of profiles integer, intent(inout), optional :: profiles_size @@ -534,8 +541,8 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si !> Index in the list of profiles integer, intent(inout), optional :: profindex - - character(len=:), allocatable :: compiler_name + + character(len=:), allocatable :: compiler_name type(toml_table), pointer :: comp_node type(toml_key), allocatable :: os_list(:) integer :: icomp, stat @@ -544,7 +551,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si if (size(comp_list)<1) return do icomp = 1, size(comp_list) call validate_compiler_name(comp_list(icomp)%key, is_valid) - if (is_valid) then + if (is_valid) then compiler_name = comp_list(icomp)%key call get_value(table, compiler_name, comp_node, stat=stat) if (stat /= toml_stat%success) then @@ -567,7 +574,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si else call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.') end if - end do + end do end subroutine traverse_compilers !> Construct new profiles array from a TOML data structure @@ -596,9 +603,9 @@ subroutine new_profiles(profiles, table, error) default_profiles = get_default_profiles(error) if (allocated(error)) return call table%get_keys(prof_list) - + if (size(prof_list) < 1) return - + profiles_size = 0 do iprof = 1, size(prof_list) @@ -633,7 +640,7 @@ subroutine new_profiles(profiles, table, error) profiles_size = profiles_size + size(default_profiles) allocate(profiles(profiles_size)) - + do profindex=1, size(default_profiles) profiles(profindex) = default_profiles(profindex) end do @@ -954,4 +961,71 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin end do end if end subroutine find_profile + + + logical function file_scope_same(this,that) + class(file_scope_flag), intent(in) :: this + class(serializable_t), intent(in) :: that + + file_scope_same = .false. + + select type (other=>that) + type is (file_scope_flag) + if (allocated(this%file_name).neqv.allocated(other%file_name)) return + if (allocated(this%file_name)) then + if (.not.(this%file_name==other%file_name)) return + endif + if (allocated(this%flags).neqv.allocated(other%flags)) return + if (allocated(this%flags)) then + if (.not.(this%flags==other%flags)) return + endif + + class default + ! Not the same type + return + end select + + !> All checks passed! + file_scope_same = .true. + + end function file_scope_same + + !> Dump to toml table + subroutine file_scope_dump(self, table, error) + + !> Instance of the serializable object + class(file_scope_flag), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call set_string(table, "file-name", self%file_name, error) + if (allocated(error)) return + call set_string(table, "flags", self%flags, error) + if (allocated(error)) return + + end subroutine file_scope_dump + + !> Read from toml table (no checks made at this stage) + subroutine file_scope_load(self, table, error) + + !> Instance of the serializable object + class(file_scope_flag), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call get_value(table, "file-name", self%file_name) + call get_value(table, "flags", self%flags) + + end subroutine file_scope_load + + + end module fpm_manifest_profile diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 2a0301d2a5..ad0a8b40c9 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -12,6 +12,7 @@ module test_toml use fpm_manifest_library use fpm_manifest_executable use fpm_manifest_preprocess + use fpm_manifest_profile use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & @@ -53,6 +54,7 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-library-config", library_config_roundtrip), & & new_unittest("serialize-executable-config", executable_config_roundtrip), & & new_unittest("serialize-preprocess-config", preprocess_config_roundtrip), & + & new_unittest("serialize-file-scope-flag", file_scope_flag_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1271,4 +1273,21 @@ subroutine preprocess_config_roundtrip(error) end subroutine preprocess_config_roundtrip + subroutine file_scope_flag_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(file_scope_flag) :: ff + + call ff%test_serialization('file_scope_flag: empty', error) + if (allocated(error)) return + + ff%file_name = "preprocessor config" + ff%flags = "-1 -f -2 -g" + + call ff%test_serialization('file_scope_flag: non-empty', error) + + end subroutine file_scope_flag_roundtrip + end module test_toml From dd81493210c4fe48882e44653550d4ef2af25fad Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 14:51:23 +0200 Subject: [PATCH 65/80] partial `profile_config_t` --- src/fpm/manifest/profiles.f90 | 153 +++++++++++++++++++++++++++++++++- src/fpm_command_line.f90 | 14 +--- src/fpm_environment.f90 | 20 +++++ 3 files changed, 172 insertions(+), 15 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 44fe65ad3a..15a0be74be 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -43,10 +43,11 @@ !> module fpm_manifest_profile use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, & + set_string, add_table use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME use fpm_filesystem, only: join_path implicit none public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & @@ -76,7 +77,7 @@ module fpm_manifest_profile end type file_scope_flag !> Configuration meta data for a profile - type :: profile_config_t + type, extends(serializable_t) :: profile_config_t !> Name of the profile character(len=:), allocatable :: profile_name @@ -109,6 +110,11 @@ module fpm_manifest_profile !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => profile_same + procedure :: dump_to_toml => profile_dump + procedure :: load_from_toml => profile_load + end type profile_config_t contains @@ -1026,6 +1032,147 @@ subroutine file_scope_load(self, table, error) end subroutine file_scope_load + logical function profile_same(this,that) + class(profile_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + profile_same = .false. + + select type (other=>that) + type is (profile_config_t) + if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return + if (allocated(this%profile_name)) then + if (.not.(this%profile_name==other%profile_name)) return + endif + if (allocated(this%compiler).neqv.allocated(other%compiler)) return + if (allocated(this%compiler)) then + if (.not.(this%compiler==other%compiler)) return + endif + if (this%os_type/=other%os_type) return + if (allocated(this%flags).neqv.allocated(other%flags)) return + if (allocated(this%flags)) then + if (.not.(this%flags==other%flags)) return + endif + if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return + if (allocated(this%c_flags)) then + if (.not.(this%c_flags==other%c_flags)) return + endif + if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return + if (allocated(this%cxx_flags)) then + if (.not.(this%cxx_flags==other%cxx_flags)) return + endif + if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return + if (allocated(this%link_time_flags)) then + if (.not.(this%link_time_flags==other%link_time_flags)) return + endif + + if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return + if (allocated(this%file_scope_flags)) then + if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return + do ii=1,size(this%file_scope_flags) + if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return + end do + endif + + if (this%is_built_in.neqv.other%is_built_in) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + profile_same = .true. + + end function profile_same + + !> Dump to toml table + subroutine profile_dump(self, table, error) + + !> Instance of the serializable object + class(profile_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + integer :: ierr, ii + type(toml_table), pointer :: ptr_deps, ptr + character(len=30) :: unnamed + + call set_string(table, "profile-name", self%profile_name, error) + if (allocated(error)) return + call set_string(table, "compiler", self%compiler, error) + if (allocated(error)) return + call set_string(table,"os-type",OS_NAME(self%os_type), error, 'profile_config_t') + if (allocated(error)) return + call set_string(table, "flags", self%flags, error) + if (allocated(error)) return + call set_string(table, "c-flags", self%c_flags, error) + if (allocated(error)) return + call set_string(table, "cxx-flags", self%cxx_flags, error) + if (allocated(error)) return + call set_string(table, "link-time-flags", self%link_time_flags, error) + if (allocated(error)) return + + if (allocated(self%file_scope_flags)) then + + ! Create dependency table + call add_table(table, "file-scope-flags", ptr_deps) + if (.not. associated(ptr_deps)) then + call fatal_error(error, "profile_config_t cannot create file scope table ") + return + end if + + do ii = 1, size(self%file_scope_flags) + associate (dep => self%file_scope_flags(ii)) + + !> Because files need a name, fallback if this has no name + if (len_trim(dep%file_name)==0) then + write(unnamed,1) ii + call add_table(ptr_deps, trim(unnamed), ptr) + else + call add_table(ptr_deps, dep%file_name, ptr) + end if + if (.not. associated(ptr)) then + call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name) + return + end if + call dep%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + + endif + + call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') + if (allocated(error)) return + + 1 format('UNNAMED_FILE_',i0) + + end subroutine profile_dump + + !> Read from toml table (no checks made at this stage) + subroutine profile_load(self, table, error) + + !> Instance of the serializable object + class(profile_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + +! call get_value(table, "file-name", self%profile_name) +! call get_value(table, "flags", self%flags) + + end subroutine profile_load end module fpm_manifest_profile diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 3b723c74c7..8cd4776b75 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -25,7 +25,7 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, os_is_unix, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name @@ -234,17 +234,7 @@ subroutine get_command_line_settings(cmd_settings) call set_help() os = get_os_type() ! text for --version switch, - select case (os) - case (OS_LINUX); os_type = "OS Type: Linux" - case (OS_MACOS); os_type = "OS Type: macOS" - case (OS_WINDOWS); os_type = "OS Type: Windows" - case (OS_CYGWIN); os_type = "OS Type: Cygwin" - case (OS_SOLARIS); os_type = "OS Type: Solaris" - case (OS_FREEBSD); os_type = "OS Type: FreeBSD" - case (OS_OPENBSD); os_type = "OS Type: OpenBSD" - case (OS_UNKNOWN); os_type = "OS Type: Unknown" - case default ; os_type = "OS Type: UNKNOWN" - end select + os_type = "OS Type: "//OS_NAME(os) is_unix = os_is_unix(os) ! Get current release version diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 7e8aa2317d..39152ab4ad 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -15,6 +15,7 @@ module fpm_environment public :: get_command_arguments_quoted public :: separator + public :: OS_NAME integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 integer, parameter, public :: OS_MACOS = 2 @@ -24,6 +25,25 @@ module fpm_environment integer, parameter, public :: OS_FREEBSD = 6 integer, parameter, public :: OS_OPENBSD = 7 contains + + !> Return string describing the OS type flag + pure function OS_NAME(os) + integer, intent(in) :: os + character(len=:), allocatable :: OS_NAME + + select case (os) + case (OS_LINUX); OS_NAME = "Linux" + case (OS_MACOS); OS_NAME = "macOS" + case (OS_WINDOWS); OS_NAME = "Windows" + case (OS_CYGWIN); OS_NAME = "Cygwin" + case (OS_SOLARIS); OS_NAME = "Solaris" + case (OS_FREEBSD); OS_NAME = "FreeBSD" + case (OS_OPENBSD); OS_NAME = "OpenBSD" + case (OS_UNKNOWN); OS_NAME = "Unknown" + case default ; OS_NAME = "UNKNOWN" + end select + end function OS_NAME + !> Determine the OS type integer function get_os_type() result(r) !! From fa8c98efd596f6b57a906765e68f58baab322cfa Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 14:51:30 +0200 Subject: [PATCH 66/80] Revert "partial `profile_config_t`" This reverts commit dd81493210c4fe48882e44653550d4ef2af25fad. --- src/fpm/manifest/profiles.f90 | 153 +--------------------------------- src/fpm_command_line.f90 | 14 +++- src/fpm_environment.f90 | 20 ----- 3 files changed, 15 insertions(+), 172 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 15a0be74be..44fe65ad3a 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -43,11 +43,10 @@ !> module fpm_manifest_profile use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, & - set_string, add_table + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_filesystem, only: join_path implicit none public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & @@ -77,7 +76,7 @@ module fpm_manifest_profile end type file_scope_flag !> Configuration meta data for a profile - type, extends(serializable_t) :: profile_config_t + type :: profile_config_t !> Name of the profile character(len=:), allocatable :: profile_name @@ -110,11 +109,6 @@ module fpm_manifest_profile !> Print information on this instance procedure :: info - !> Serialization interface - procedure :: serializable_is_same => profile_same - procedure :: dump_to_toml => profile_dump - procedure :: load_from_toml => profile_load - end type profile_config_t contains @@ -1032,147 +1026,6 @@ subroutine file_scope_load(self, table, error) end subroutine file_scope_load - logical function profile_same(this,that) - class(profile_config_t), intent(in) :: this - class(serializable_t), intent(in) :: that - - integer :: ii - - profile_same = .false. - - select type (other=>that) - type is (profile_config_t) - if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return - if (allocated(this%profile_name)) then - if (.not.(this%profile_name==other%profile_name)) return - endif - if (allocated(this%compiler).neqv.allocated(other%compiler)) return - if (allocated(this%compiler)) then - if (.not.(this%compiler==other%compiler)) return - endif - if (this%os_type/=other%os_type) return - if (allocated(this%flags).neqv.allocated(other%flags)) return - if (allocated(this%flags)) then - if (.not.(this%flags==other%flags)) return - endif - if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return - if (allocated(this%c_flags)) then - if (.not.(this%c_flags==other%c_flags)) return - endif - if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return - if (allocated(this%cxx_flags)) then - if (.not.(this%cxx_flags==other%cxx_flags)) return - endif - if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return - if (allocated(this%link_time_flags)) then - if (.not.(this%link_time_flags==other%link_time_flags)) return - endif - - if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return - if (allocated(this%file_scope_flags)) then - if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return - do ii=1,size(this%file_scope_flags) - if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return - end do - endif - - if (this%is_built_in.neqv.other%is_built_in) return - - class default - ! Not the same type - return - end select - - !> All checks passed! - profile_same = .true. - - end function profile_same - - !> Dump to toml table - subroutine profile_dump(self, table, error) - - !> Instance of the serializable object - class(profile_config_t), intent(inout) :: self - - !> Data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - !> Local variables - integer :: ierr, ii - type(toml_table), pointer :: ptr_deps, ptr - character(len=30) :: unnamed - - call set_string(table, "profile-name", self%profile_name, error) - if (allocated(error)) return - call set_string(table, "compiler", self%compiler, error) - if (allocated(error)) return - call set_string(table,"os-type",OS_NAME(self%os_type), error, 'profile_config_t') - if (allocated(error)) return - call set_string(table, "flags", self%flags, error) - if (allocated(error)) return - call set_string(table, "c-flags", self%c_flags, error) - if (allocated(error)) return - call set_string(table, "cxx-flags", self%cxx_flags, error) - if (allocated(error)) return - call set_string(table, "link-time-flags", self%link_time_flags, error) - if (allocated(error)) return - - if (allocated(self%file_scope_flags)) then - - ! Create dependency table - call add_table(table, "file-scope-flags", ptr_deps) - if (.not. associated(ptr_deps)) then - call fatal_error(error, "profile_config_t cannot create file scope table ") - return - end if - - do ii = 1, size(self%file_scope_flags) - associate (dep => self%file_scope_flags(ii)) - - !> Because files need a name, fallback if this has no name - if (len_trim(dep%file_name)==0) then - write(unnamed,1) ii - call add_table(ptr_deps, trim(unnamed), ptr) - else - call add_table(ptr_deps, dep%file_name, ptr) - end if - if (.not. associated(ptr)) then - call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name) - return - end if - call dep%dump_to_toml(ptr, error) - if (allocated(error)) return - end associate - end do - - endif - - call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') - if (allocated(error)) return - - 1 format('UNNAMED_FILE_',i0) - - end subroutine profile_dump - - !> Read from toml table (no checks made at this stage) - subroutine profile_load(self, table, error) - - !> Instance of the serializable object - class(profile_config_t), intent(inout) :: self - - !> Data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - -! call get_value(table, "file-name", self%profile_name) -! call get_value(table, "flags", self%flags) - - end subroutine profile_load end module fpm_manifest_profile diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 8cd4776b75..3b723c74c7 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -25,7 +25,7 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, os_is_unix, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name @@ -234,7 +234,17 @@ subroutine get_command_line_settings(cmd_settings) call set_help() os = get_os_type() ! text for --version switch, - os_type = "OS Type: "//OS_NAME(os) + select case (os) + case (OS_LINUX); os_type = "OS Type: Linux" + case (OS_MACOS); os_type = "OS Type: macOS" + case (OS_WINDOWS); os_type = "OS Type: Windows" + case (OS_CYGWIN); os_type = "OS Type: Cygwin" + case (OS_SOLARIS); os_type = "OS Type: Solaris" + case (OS_FREEBSD); os_type = "OS Type: FreeBSD" + case (OS_OPENBSD); os_type = "OS Type: OpenBSD" + case (OS_UNKNOWN); os_type = "OS Type: Unknown" + case default ; os_type = "OS Type: UNKNOWN" + end select is_unix = os_is_unix(os) ! Get current release version diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 39152ab4ad..7e8aa2317d 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -15,7 +15,6 @@ module fpm_environment public :: get_command_arguments_quoted public :: separator - public :: OS_NAME integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 integer, parameter, public :: OS_MACOS = 2 @@ -25,25 +24,6 @@ module fpm_environment integer, parameter, public :: OS_FREEBSD = 6 integer, parameter, public :: OS_OPENBSD = 7 contains - - !> Return string describing the OS type flag - pure function OS_NAME(os) - integer, intent(in) :: os - character(len=:), allocatable :: OS_NAME - - select case (os) - case (OS_LINUX); OS_NAME = "Linux" - case (OS_MACOS); OS_NAME = "macOS" - case (OS_WINDOWS); OS_NAME = "Windows" - case (OS_CYGWIN); OS_NAME = "Cygwin" - case (OS_SOLARIS); OS_NAME = "Solaris" - case (OS_FREEBSD); OS_NAME = "FreeBSD" - case (OS_OPENBSD); OS_NAME = "OpenBSD" - case (OS_UNKNOWN); OS_NAME = "Unknown" - case default ; OS_NAME = "UNKNOWN" - end select - end function OS_NAME - !> Determine the OS type integer function get_os_type() result(r) !! From a7cb2a011923159b3f50a127559efe7718a86747 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 14:52:01 +0200 Subject: [PATCH 67/80] Revert "Revert "partial `profile_config_t`"" This reverts commit fa8c98efd596f6b57a906765e68f58baab322cfa. --- src/fpm/manifest/profiles.f90 | 153 +++++++++++++++++++++++++++++++++- src/fpm_command_line.f90 | 14 +--- src/fpm_environment.f90 | 20 +++++ 3 files changed, 172 insertions(+), 15 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 44fe65ad3a..15a0be74be 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -43,10 +43,11 @@ !> module fpm_manifest_profile use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, & + set_string, add_table use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME use fpm_filesystem, only: join_path implicit none public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & @@ -76,7 +77,7 @@ module fpm_manifest_profile end type file_scope_flag !> Configuration meta data for a profile - type :: profile_config_t + type, extends(serializable_t) :: profile_config_t !> Name of the profile character(len=:), allocatable :: profile_name @@ -109,6 +110,11 @@ module fpm_manifest_profile !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => profile_same + procedure :: dump_to_toml => profile_dump + procedure :: load_from_toml => profile_load + end type profile_config_t contains @@ -1026,6 +1032,147 @@ subroutine file_scope_load(self, table, error) end subroutine file_scope_load + logical function profile_same(this,that) + class(profile_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + profile_same = .false. + + select type (other=>that) + type is (profile_config_t) + if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return + if (allocated(this%profile_name)) then + if (.not.(this%profile_name==other%profile_name)) return + endif + if (allocated(this%compiler).neqv.allocated(other%compiler)) return + if (allocated(this%compiler)) then + if (.not.(this%compiler==other%compiler)) return + endif + if (this%os_type/=other%os_type) return + if (allocated(this%flags).neqv.allocated(other%flags)) return + if (allocated(this%flags)) then + if (.not.(this%flags==other%flags)) return + endif + if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return + if (allocated(this%c_flags)) then + if (.not.(this%c_flags==other%c_flags)) return + endif + if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return + if (allocated(this%cxx_flags)) then + if (.not.(this%cxx_flags==other%cxx_flags)) return + endif + if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return + if (allocated(this%link_time_flags)) then + if (.not.(this%link_time_flags==other%link_time_flags)) return + endif + + if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return + if (allocated(this%file_scope_flags)) then + if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return + do ii=1,size(this%file_scope_flags) + if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return + end do + endif + + if (this%is_built_in.neqv.other%is_built_in) return + + class default + ! Not the same type + return + end select + + !> All checks passed! + profile_same = .true. + + end function profile_same + + !> Dump to toml table + subroutine profile_dump(self, table, error) + + !> Instance of the serializable object + class(profile_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Local variables + integer :: ierr, ii + type(toml_table), pointer :: ptr_deps, ptr + character(len=30) :: unnamed + + call set_string(table, "profile-name", self%profile_name, error) + if (allocated(error)) return + call set_string(table, "compiler", self%compiler, error) + if (allocated(error)) return + call set_string(table,"os-type",OS_NAME(self%os_type), error, 'profile_config_t') + if (allocated(error)) return + call set_string(table, "flags", self%flags, error) + if (allocated(error)) return + call set_string(table, "c-flags", self%c_flags, error) + if (allocated(error)) return + call set_string(table, "cxx-flags", self%cxx_flags, error) + if (allocated(error)) return + call set_string(table, "link-time-flags", self%link_time_flags, error) + if (allocated(error)) return + + if (allocated(self%file_scope_flags)) then + + ! Create dependency table + call add_table(table, "file-scope-flags", ptr_deps) + if (.not. associated(ptr_deps)) then + call fatal_error(error, "profile_config_t cannot create file scope table ") + return + end if + + do ii = 1, size(self%file_scope_flags) + associate (dep => self%file_scope_flags(ii)) + + !> Because files need a name, fallback if this has no name + if (len_trim(dep%file_name)==0) then + write(unnamed,1) ii + call add_table(ptr_deps, trim(unnamed), ptr) + else + call add_table(ptr_deps, dep%file_name, ptr) + end if + if (.not. associated(ptr)) then + call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name) + return + end if + call dep%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + + endif + + call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') + if (allocated(error)) return + + 1 format('UNNAMED_FILE_',i0) + + end subroutine profile_dump + + !> Read from toml table (no checks made at this stage) + subroutine profile_load(self, table, error) + + !> Instance of the serializable object + class(profile_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + +! call get_value(table, "file-name", self%profile_name) +! call get_value(table, "flags", self%flags) + + end subroutine profile_load end module fpm_manifest_profile diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 3b723c74c7..8cd4776b75 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -25,7 +25,7 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, os_is_unix, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name @@ -234,17 +234,7 @@ subroutine get_command_line_settings(cmd_settings) call set_help() os = get_os_type() ! text for --version switch, - select case (os) - case (OS_LINUX); os_type = "OS Type: Linux" - case (OS_MACOS); os_type = "OS Type: macOS" - case (OS_WINDOWS); os_type = "OS Type: Windows" - case (OS_CYGWIN); os_type = "OS Type: Cygwin" - case (OS_SOLARIS); os_type = "OS Type: Solaris" - case (OS_FREEBSD); os_type = "OS Type: FreeBSD" - case (OS_OPENBSD); os_type = "OS Type: OpenBSD" - case (OS_UNKNOWN); os_type = "OS Type: Unknown" - case default ; os_type = "OS Type: UNKNOWN" - end select + os_type = "OS Type: "//OS_NAME(os) is_unix = os_is_unix(os) ! Get current release version diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 7e8aa2317d..39152ab4ad 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -15,6 +15,7 @@ module fpm_environment public :: get_command_arguments_quoted public :: separator + public :: OS_NAME integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 integer, parameter, public :: OS_MACOS = 2 @@ -24,6 +25,25 @@ module fpm_environment integer, parameter, public :: OS_FREEBSD = 6 integer, parameter, public :: OS_OPENBSD = 7 contains + + !> Return string describing the OS type flag + pure function OS_NAME(os) + integer, intent(in) :: os + character(len=:), allocatable :: OS_NAME + + select case (os) + case (OS_LINUX); OS_NAME = "Linux" + case (OS_MACOS); OS_NAME = "macOS" + case (OS_WINDOWS); OS_NAME = "Windows" + case (OS_CYGWIN); OS_NAME = "Cygwin" + case (OS_SOLARIS); OS_NAME = "Solaris" + case (OS_FREEBSD); OS_NAME = "FreeBSD" + case (OS_OPENBSD); OS_NAME = "OpenBSD" + case (OS_UNKNOWN); OS_NAME = "Unknown" + case default ; OS_NAME = "UNKNOWN" + end select + end function OS_NAME + !> Determine the OS type integer function get_os_type() result(r) !! From 54f1231db987ea8c445f4733b4361936ccd0f925 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 15:21:35 +0200 Subject: [PATCH 68/80] serialize `profile_config_t`, test, bugfix OS check --- src/fpm/manifest/profiles.f90 | 87 ++++++++++++++++++++++++++++++--- test/fpm_test/test_manifest.f90 | 16 ++++++ 2 files changed, 96 insertions(+), 7 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 15a0be74be..1852118374 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -85,7 +85,7 @@ module fpm_manifest_profile character(len=:), allocatable :: compiler !> Value repesenting OS - integer :: os_type + integer :: os_type = OS_ALL !> Fortran compiler flags character(len=:), allocatable :: flags @@ -103,7 +103,7 @@ module fpm_manifest_profile type(file_scope_flag), allocatable :: file_scope_flags(:) !> Is this profile one of the built-in ones? - logical :: is_built_in + logical :: is_built_in = .false. contains @@ -234,7 +234,8 @@ subroutine match_os_type(os_name, os_type) select case (os_name) case ("linux"); os_type = OS_LINUX - case ("macos"); os_type = OS_WINDOWS + case ("macos"); os_type = OS_MACOS + case ("windows"); os_type = OS_WINDOWS case ("cygwin"); os_type = OS_CYGWIN case ("solaris"); os_type = OS_SOLARIS case ("freebsd"); os_type = OS_FREEBSD @@ -245,6 +246,22 @@ subroutine match_os_type(os_name, os_type) end subroutine match_os_type + !> Match lowercase string with name of OS to os_type enum + function os_type_name(os_type) + + !> Name of operating system + character(len=:), allocatable :: os_type_name + + !> Enum representing type of OS + integer, intent(in) :: os_type + + select case (os_type) + case (OS_ALL); os_type_name = "all" + case default; os_type_name = lower(OS_NAME(os_type)) + end select + + end function os_type_name + subroutine validate_profile_table(profile_name, compiler_name, key_list, table, error, os_valid) !> Name of profile @@ -849,7 +866,7 @@ subroutine info(self, unit, verbosity) write(unit, fmt) "- compiler", self%compiler end if - write(unit, fmt) "- os", self%os_type + write(unit, fmt) "- os", os_type_name(self%os_type) if (allocated(self%flags)) then write(unit, fmt) "- compiler flags", self%flags @@ -1042,40 +1059,51 @@ logical function profile_same(this,that) select type (other=>that) type is (profile_config_t) + print *, 'check name' if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return if (allocated(this%profile_name)) then if (.not.(this%profile_name==other%profile_name)) return endif + print *, 'check compiler' if (allocated(this%compiler).neqv.allocated(other%compiler)) return if (allocated(this%compiler)) then if (.not.(this%compiler==other%compiler)) return endif + print *, 'check os' if (this%os_type/=other%os_type) return + print *, 'check flags' if (allocated(this%flags).neqv.allocated(other%flags)) return if (allocated(this%flags)) then if (.not.(this%flags==other%flags)) return endif + print *, 'check cflags' if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return if (allocated(this%c_flags)) then if (.not.(this%c_flags==other%c_flags)) return endif + print *, 'check cxxflags' if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return if (allocated(this%cxx_flags)) then if (.not.(this%cxx_flags==other%cxx_flags)) return endif + print *, 'check link' if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return if (allocated(this%link_time_flags)) then if (.not.(this%link_time_flags==other%link_time_flags)) return endif + print *, 'check file scope' + if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return if (allocated(this%file_scope_flags)) then if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return do ii=1,size(this%file_scope_flags) + print *, 'check ii-th file scope: ',ii if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return end do endif + print *, 'check builtin' if (this%is_built_in.neqv.other%is_built_in) return class default @@ -1109,7 +1137,8 @@ subroutine profile_dump(self, table, error) if (allocated(error)) return call set_string(table, "compiler", self%compiler, error) if (allocated(error)) return - call set_string(table,"os-type",OS_NAME(self%os_type), error, 'profile_config_t') + print *, 'save os-type = ',os_type_name(self%os_type) + call set_string(table,"os-type",os_type_name(self%os_type), error, 'profile_config_t') if (allocated(error)) return call set_string(table, "flags", self%flags, error) if (allocated(error)) return @@ -1169,8 +1198,52 @@ subroutine profile_load(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error -! call get_value(table, "file-name", self%profile_name) -! call get_value(table, "flags", self%flags) + !> Local variables + character(len=:), allocatable :: flag + integer :: ii, jj + type(toml_table), pointer :: ptr_dep, ptr + type(toml_key), allocatable :: keys(:),dep_keys(:) + + call table%get_keys(keys) + + call get_value(table, "profile-name", self%profile_name) + call get_value(table, "compiler", self%compiler) + call get_value(table,"os-type",flag) + print *, 'OS flag = ',flag + call match_os_type(flag, self%os_type) + call get_value(table, "flags", self%flags) + call get_value(table, "c-flags", self%c_flags) + call get_value(table, "cxx-flags", self%cxx_flags) + call get_value(table, "link-time-flags", self%link_time_flags) + call get_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') + if (allocated(error)) return + + if (allocated(self%file_scope_flags)) deallocate(self%file_scope_flags) + sub_deps: do ii = 1, size(keys) + + select case (keys(ii)%key) + case ("file-scope-flags") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,'profile_config_t: error retrieving file_scope_flags table') + return + end if + + !> Read all packages + call ptr%get_keys(dep_keys) + allocate(self%file_scope_flags(size(dep_keys))) + + do jj = 1, size(dep_keys) + + call get_value(ptr, dep_keys(jj), ptr_dep) + call self%file_scope_flags(jj)%load_from_toml(ptr_dep, error) + if (allocated(error)) return + + end do + + end select + end do sub_deps end subroutine profile_load diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 917fd314fd..676189ccb6 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -517,6 +517,9 @@ subroutine test_profiles(error) return end if + call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) + if (allocated(error)) return + profile_name = 'release' compiler = 'gfortran' call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) @@ -525,6 +528,9 @@ subroutine test_profiles(error) return end if + call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) + if (allocated(error)) return + profile_name = 'publish' compiler = 'gfortran' call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) @@ -533,6 +539,9 @@ subroutine test_profiles(error) return end if + call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) + if (allocated(error)) return + profile_name = 'debug' compiler = 'ifort' call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) @@ -541,6 +550,9 @@ subroutine test_profiles(error) return end if + call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) + if (allocated(error)) return + profile_name = 'release' compiler = 'ifort' call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) @@ -548,6 +560,10 @@ subroutine test_profiles(error) call test_failed(error, "Failed to overwrite built-in profile") return end if + + call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) + if (allocated(error)) return + end subroutine test_profiles !> 'flags' is a key-value entry, test should fail as it is defined as a table From 432cbab11a15eb966c4e9a1a63ce20202efd9bc5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 16:02:08 +0200 Subject: [PATCH 69/80] serialize `package_config_t` --- src/fpm/manifest/package.f90 | 552 ++++++++++++++++++++++++++++++++++- src/fpm_model.f90 | 1 - 2 files changed, 550 insertions(+), 3 deletions(-) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index db5beba5ed..120344d907 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -46,7 +46,8 @@ module fpm_manifest_package use fpm_manifest_preprocess, only : preprocess_config_t, new_preprocessors use fpm_filesystem, only : exists, getline, join_path use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error - use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, len + use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, len, & + serializable_t, set_value, set_string, set_list, add_table use fpm_versioning, only : version_t, new_version implicit none private @@ -61,7 +62,7 @@ module fpm_manifest_package !> Package meta data - type :: package_config_t + type, extends(serializable_t) :: package_config_t !> Name of the package character(len=:), allocatable :: name @@ -110,8 +111,15 @@ module fpm_manifest_package !> Print information on this instance procedure :: info + !> Serialization interface + procedure :: serializable_is_same => manifest_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + end type package_config_t + character(len=*), parameter, private :: class_name = 'package_config_t' + contains @@ -507,5 +515,545 @@ subroutine unique_programs2(executable_i, executable_j, error) end subroutine unique_programs2 + logical function manifest_is_same(this,that) + class(package_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + manifest_is_same = .false. + + select type (other=>that) + type is (package_config_t) + + if (.not.this%name==other%name) return + if (.not.this%version==other%version) return + if (.not.this%build==other%build) return + if (.not.this%install==other%install) return + if (.not.this%fortran==other%fortran) return + if (.not.this%license==other%license) return + if (allocated(this%library).neqv.allocated(other%library)) return + if (allocated(this%library)) then + if (.not.this%library==other%library) return + endif + if (allocated(this%executable).neqv.allocated(other%executable)) return + if (allocated(this%executable)) then + if (.not.size(this%executable)==size(other%executable)) return + do ii=1,size(this%executable) + if (.not.this%executable(ii)==other%executable(ii)) return + end do + end if + if (allocated(this%dependency).neqv.allocated(other%dependency)) return + if (allocated(this%dependency)) then + if (.not.size(this%dependency)==size(other%dependency)) return + do ii=1,size(this%dependency) + if (.not.this%dependency(ii)==other%dependency(ii)) return + end do + end if + if (allocated(this%dev_dependency).neqv.allocated(other%dev_dependency)) return + if (allocated(this%dev_dependency)) then + if (.not.size(this%dev_dependency)==size(other%dev_dependency)) return + do ii=1,size(this%dev_dependency) + if (.not.this%dev_dependency(ii)==other%dev_dependency(ii)) return + end do + end if + if (allocated(this%profiles).neqv.allocated(other%profiles)) return + if (allocated(this%profiles)) then + if (.not.size(this%profiles)==size(other%profiles)) return + do ii=1,size(this%profiles) + if (.not.this%profiles(ii)==other%profiles(ii)) return + end do + end if + if (allocated(this%example).neqv.allocated(other%example)) return + if (allocated(this%example)) then + if (.not.size(this%example)==size(other%example)) return + do ii=1,size(this%example) + if (.not.this%example(ii)==other%example(ii)) return + end do + end if + if (allocated(this%preprocess).neqv.allocated(other%preprocess)) return + if (allocated(this%preprocess)) then + if (.not.size(this%preprocess)==size(other%preprocess)) return + do ii=1,size(this%preprocess) + if (.not.this%preprocess(ii)==other%preprocess(ii)) return + end do + end if + if (allocated(this%test).neqv.allocated(other%test)) return + if (allocated(this%test)) then + if (.not.size(this%test)==size(other%test)) return + do ii=1,size(this%test) + if (.not.this%test(ii)==other%test(ii)) return + end do + end if + + class default + ! Not the same type + return + end select + + !> All checks passed! + manifest_is_same = .true. + + end function manifest_is_same + + !> Dump manifest to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(package_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ierr, ii + type(toml_table), pointer :: ptr,ptr_pkg + character(30) :: unnamed + + call set_string(table, "name", self%name, error, class_name) + if (allocated(error)) return + call set_string(table, "version", self%version%s(), error, class_name) + if (allocated(error)) return + call set_string(table, "license", self%license, error, class_name) + if (allocated(error)) return + + call add_table(table, "build", ptr, error, class_name) + if (allocated(error)) return + call self%build%dump_to_toml(ptr, error) + if (allocated(error)) return + + call add_table(table, "fortran", ptr, error, class_name) + if (allocated(error)) return + call self%fortran%dump_to_toml(ptr, error) + if (allocated(error)) return + + call add_table(table, "install", ptr, error, class_name) + if (allocated(error)) return + call self%install%dump_to_toml(ptr, error) + if (allocated(error)) return + + if (allocated(self%library)) then + call add_table(table, "library", ptr, error, class_name) + if (allocated(error)) return + call self%library%dump_to_toml(ptr, error) + if (allocated(error)) return + end if + + if (allocated(self%executable)) then + + call add_table(table, "executable", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'executable' table ") + return + end if + + do ii = 1, size(self%executable) + + associate (pkg => self%executable(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'EXECUTABLE',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(executable)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(executable)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%dependency)) then + + call add_table(table, "dependencies", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'dependencies' table ") + return + end if + + do ii = 1, size(self%dependency) + + associate (pkg => self%dependency(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'DEPENDENCY',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(dependencies)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(dependencies)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%dev_dependency)) then + + call add_table(table, "dev-dependencies", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'dev-dependencies' table ") + return + end if + + do ii = 1, size(self%dev_dependency) + + associate (pkg => self%dev_dependency(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'DEV-DEPENDENCY',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(dev-dependencies)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(dev-dependencies)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%profiles)) then + + call add_table(table, "profiles", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'profiles' table ") + return + end if + + do ii = 1, size(self%profiles) + + associate (pkg => self%profiles(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%profile_name)==0) then + write(unnamed,1) 'PROFILE',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(profiles)') + else + call add_table(ptr_pkg, pkg%profile_name, ptr, error, class_name//'(profiles)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%example)) then + + call add_table(table, "example", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'example' table ") + return + end if + + do ii = 1, size(self%example) + + associate (pkg => self%example(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'EXAMPLE',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(example)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(example)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%test)) then + + call add_table(table, "test", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'test' table ") + return + end if + + do ii = 1, size(self%test) + + associate (pkg => self%test(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'TEST',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(test)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(test)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%preprocess)) then + + call add_table(table, "preprocess", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'preprocess' table ") + return + end if + + do ii = 1, size(self%preprocess) + + associate (pkg => self%preprocess(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'PREPROCESS',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(preprocess)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(preprocess)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + 1 format('UNNAMED_',a,'_',i0) + + end subroutine dump_to_toml + + !> Read manifest from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(package_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: keys(:),pkg_keys(:) + integer :: ierr, ii, jj + character(len=:), allocatable :: flag + type(toml_table), pointer :: ptr,ptr_pkg + + call table%get_keys(keys) + + call get_value(table, "name", self%name) + call get_value(table, "license", self%license) + call get_value(table, "version", flag) + call new_version(self%version, flag, error) + if (allocated(error)) then + error%message = class_name//': version error from TOML table - '//error%message + return + endif + + if (allocated(self%library)) deallocate(self%library) + if (allocated(self%executable)) deallocate(self%executable) + if (allocated(self%dependency)) deallocate(self%dependency) + if (allocated(self%dev_dependency)) deallocate(self%dev_dependency) + if (allocated(self%profiles)) deallocate(self%profiles) + if (allocated(self%example)) deallocate(self%example) + if (allocated(self%test)) deallocate(self%test) + if (allocated(self%preprocess)) deallocate(self%preprocess) + sub_deps: do ii = 1, size(keys) + + select case (keys(ii)%key) + case ("build") + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%build%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("install") + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%install%load_from_toml(ptr, error) + + case ("fortran") + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%fortran%load_from_toml(ptr, error) + + case ("library") + + allocate(self%library) + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%library%load_from_toml(ptr, error) + + case ("executable") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving executable table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%executable(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%executable(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("dependencies") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving dependency table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%dependency(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%dependency(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("dev-dependencies") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving dev-dependencies table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%dev_dependency(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%dev_dependency(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("profiles") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving profiles table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%profiles(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%profiles(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("example") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving example table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%example(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%example(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("test") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving test table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%test(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%test(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("preprocess") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving preprocess table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%preprocess(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%preprocess(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case default + cycle sub_deps + end select + + end do sub_deps + + end subroutine load_from_toml end module fpm_manifest_package diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index e34f955246..609e84cfec 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -980,7 +980,6 @@ subroutine model_load_from_toml(self, table, error) type(toml_key), allocatable :: keys(:),pkg_keys(:) integer :: ierr, ii, jj type(toml_table), pointer :: ptr,ptr_pkg - character(27) :: unnamed call table%get_keys(keys) From 8023c5367a20b58ef800c35577e472496435e45d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 17:24:40 +0200 Subject: [PATCH 70/80] manifest: bugfix and test serialization --- src/fpm/manifest/build.f90 | 7 +++---- src/fpm/manifest/install.f90 | 2 +- src/fpm/manifest/package.f90 | 13 +++++-------- src/fpm/manifest/profiles.f90 | 11 ----------- test/fpm_test/test_manifest.f90 | 12 +++++++++++- 5 files changed, 20 insertions(+), 25 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 4c743927a9..035ea0d51d 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -105,9 +105,8 @@ subroutine new_build_config(self, table, package_name, error) if (stat == toml_stat%success) then - ! Boolean value found. Set no custom prefix. This also falls back to - ! key not provided - self%module_prefix = string_t("") + ! Boolean value found. Set no custom prefix. This also falls back to key not provided + if (allocated(self%module_prefix%s)) deallocate(self%module_prefix%s) else @@ -306,7 +305,7 @@ subroutine load_from_toml(self, table, error) call get_value(table, "module-naming", self%module_naming, .false., stat=stat) if (stat == toml_stat%success) then ! Boolean value found. Set no custom prefix. This also falls back to key not provided - self%module_prefix = string_t("") + if (allocated(self%module_prefix%s)) deallocate(self%module_prefix%s) else !> Value found, but not a boolean. Attempt to read a prefix string call get_value(table, "module-naming", self%module_prefix%s) diff --git a/src/fpm/manifest/install.f90 b/src/fpm/manifest/install.f90 index 5c0f46837f..88c3097eb0 100644 --- a/src/fpm/manifest/install.f90 +++ b/src/fpm/manifest/install.f90 @@ -17,7 +17,7 @@ module fpm_manifest_install type, extends(serializable_t) :: install_config_t !> Install library with this project - logical :: library + logical :: library = .false. contains diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 120344d907..26d7f56ad0 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -611,6 +611,7 @@ subroutine dump_to_toml(self, table, error) integer :: ierr, ii type(toml_table), pointer :: ptr,ptr_pkg character(30) :: unnamed + character(128) :: profile_name call set_string(table, "name", self%name, error, class_name) if (allocated(error)) return @@ -740,14 +741,10 @@ subroutine dump_to_toml(self, table, error) associate (pkg => self%profiles(ii)) - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%profile_name)==0) then - write(unnamed,1) 'PROFILE',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(profiles)') - else - call add_table(ptr_pkg, pkg%profile_name, ptr, error, class_name//'(profiles)') - end if + !> Duplicate profile names are possible, as multiple profiles are possible with the + !> same name, same compiler, etc. So, use a unique name here + write(profile_name,1) 'PROFILE',ii + call add_table(ptr_pkg, trim(profile_name), ptr, error, class_name//'(profiles)') if (allocated(error)) return call pkg%dump_to_toml(ptr, error) if (allocated(error)) return diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 1852118374..951f5bfdab 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1059,41 +1059,32 @@ logical function profile_same(this,that) select type (other=>that) type is (profile_config_t) - print *, 'check name' if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return if (allocated(this%profile_name)) then if (.not.(this%profile_name==other%profile_name)) return endif - print *, 'check compiler' if (allocated(this%compiler).neqv.allocated(other%compiler)) return if (allocated(this%compiler)) then if (.not.(this%compiler==other%compiler)) return endif - print *, 'check os' if (this%os_type/=other%os_type) return - print *, 'check flags' if (allocated(this%flags).neqv.allocated(other%flags)) return if (allocated(this%flags)) then if (.not.(this%flags==other%flags)) return endif - print *, 'check cflags' if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return if (allocated(this%c_flags)) then if (.not.(this%c_flags==other%c_flags)) return endif - print *, 'check cxxflags' if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return if (allocated(this%cxx_flags)) then if (.not.(this%cxx_flags==other%cxx_flags)) return endif - print *, 'check link' if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return if (allocated(this%link_time_flags)) then if (.not.(this%link_time_flags==other%link_time_flags)) return endif - print *, 'check file scope' - if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return if (allocated(this%file_scope_flags)) then if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return @@ -1103,7 +1094,6 @@ logical function profile_same(this,that) end do endif - print *, 'check builtin' if (this%is_built_in.neqv.other%is_built_in) return class default @@ -1209,7 +1199,6 @@ subroutine profile_load(self, table, error) call get_value(table, "profile-name", self%profile_name) call get_value(table, "compiler", self%compiler) call get_value(table,"os-type",flag) - print *, 'OS flag = ',flag call match_os_type(flag, self%os_type) call get_value(table, "flags", self%flags) call get_value(table, "c-flags", self%c_flags) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 676189ccb6..58f6ad7e22 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -167,6 +167,10 @@ subroutine test_valid_manifest(error) return end if + ! Test package serialization + call package%test_serialization('test_valid_manifest',error) + if (allocated(error)) return + end subroutine test_valid_manifest @@ -220,6 +224,9 @@ subroutine test_default_library(error) return end if + call package%test_serialization('test_default_library',error) + if (allocated(error)) return + end subroutine test_default_library @@ -243,6 +250,9 @@ subroutine test_default_executable(error) & "Default executable name") if (allocated(error)) return + call package%test_serialization('test_default_executable',error) + if (allocated(error)) return + end subroutine test_default_executable @@ -1253,7 +1263,7 @@ subroutine test_link_array(error) if (allocated(error)) return !> Test serialization roundtrip - call build%test_serialization('test_link_string', error) + call build%test_serialization('test_link_array', error) if (allocated(error)) return end subroutine test_link_array From bcba0e133b914ba6bdd55c323813bf1f35d22481 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 17:35:49 +0200 Subject: [PATCH 71/80] fix `version_t` bug --- src/fpm/versioning.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/fpm/versioning.f90 b/src/fpm/versioning.f90 index 4c7c01712a..6f32a183a9 100644 --- a/src/fpm/versioning.f90 +++ b/src/fpm/versioning.f90 @@ -227,15 +227,17 @@ pure function s(self) result(string) 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 (allocated(self%num)) then + 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 + endif if (.not.allocated(string)) then string = '0' From 71a94633568e3a4af0235e84b1cac63c133d465f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 17:42:20 +0200 Subject: [PATCH 72/80] fix more `version_t` bound errors --- src/fpm/versioning.f90 | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/src/fpm/versioning.f90 b/src/fpm/versioning.f90 index 6f32a183a9..d8f4f46432 100644 --- a/src/fpm/versioning.f90 +++ b/src/fpm/versioning.f90 @@ -227,17 +227,15 @@ pure function s(self) result(string) character(len=buffersize) :: buffer integer :: ii - if (allocated(self%num)) then - 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 - endif + do ii = 1, ndigits(self) + 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' @@ -298,18 +296,18 @@ elemental function greater(lhs, rhs) result(is_greater) !> First version is greater logical :: is_greater - integer :: ii + integer :: ii, lhs_size, rhs_size - do ii = 1, min(size(lhs%num), size(rhs%num)) + do ii = 1, min(ndigits(lhs),ndigits(rhs)) if (lhs%num(ii) /= rhs%num(ii)) then is_greater = lhs%num(ii) > rhs%num(ii) return end if end do - is_greater = size(lhs%num) > size(rhs%num) + is_greater = ndigits(lhs) > ndigits(rhs) if (is_greater) then - do ii = size(rhs%num) + 1, size(lhs%num) + do ii = ndigits(rhs) + 1, ndigits(lhs) is_greater = lhs%num(ii) > 0 if (is_greater) return end do @@ -392,5 +390,17 @@ elemental function match(lhs, rhs) end function match + !> Number of digits + elemental integer function ndigits(self) + class(version_t), intent(in) :: self + + if (allocated(self%num)) then + ndigits = size(self%num) + else + ndigits = 0 + end if + + end function ndigits + end module fpm_versioning From 2990bc726929d85c3a35b1da95e41b1e2f47e62a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 17:42:28 +0200 Subject: [PATCH 73/80] cleanup --- src/fpm/manifest/profiles.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 951f5bfdab..6b139910d9 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1127,7 +1127,6 @@ subroutine profile_dump(self, table, error) if (allocated(error)) return call set_string(table, "compiler", self%compiler, error) if (allocated(error)) return - print *, 'save os-type = ',os_type_name(self%os_type) call set_string(table,"os-type",os_type_name(self%os_type), error, 'profile_config_t') if (allocated(error)) return call set_string(table, "flags", self%flags, error) From 170070b2268fa0c6986d3036b99ed672b32505a2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 18:36:17 +0200 Subject: [PATCH 74/80] deploy `fpm export` --- app/main.f90 | 4 ++ src/fpm/cmd/export.f90 | 83 ++++++++++++++++++++++++++++++++++++ src/fpm/cmd/update.f90 | 2 +- src/fpm/manifest/package.f90 | 3 +- src/fpm_command_line.f90 | 47 ++++++++++++++++++-- 5 files changed, 134 insertions(+), 5 deletions(-) create mode 100644 src/fpm/cmd/export.f90 diff --git a/app/main.f90 b/app/main.f90 index 95df065097..4bd3ac5e33 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -4,6 +4,7 @@ program main fpm_cmd_settings, & fpm_new_settings, & fpm_build_settings, & + fpm_export_settings, & fpm_run_settings, & fpm_test_settings, & fpm_install_settings, & @@ -15,6 +16,7 @@ program main use fpm_filesystem, only: exists, parent_dir, join_path use fpm, only: cmd_build, cmd_run, cmd_clean use fpm_cmd_install, only: cmd_install +use fpm_cmd_export, only: cmd_export use fpm_cmd_new, only: cmd_new use fpm_cmd_update, only : cmd_update use fpm_cmd_publish, only: cmd_publish @@ -76,6 +78,8 @@ program main call cmd_run(settings,test=.false.) type is (fpm_test_settings) call cmd_run(settings,test=.true.) +type is (fpm_export_settings) + call cmd_export(settings) type is (fpm_install_settings) call cmd_install(settings) type is (fpm_update_settings) diff --git a/src/fpm/cmd/export.f90 b/src/fpm/cmd/export.f90 new file mode 100644 index 0000000000..6386c8853a --- /dev/null +++ b/src/fpm/cmd/export.f90 @@ -0,0 +1,83 @@ +module fpm_cmd_export + use fpm_command_line, only : fpm_export_settings + use fpm_dependency, only : dependency_tree_t, new_dependency_tree + use fpm_error, only : error_t, fpm_stop + use fpm_filesystem, only : join_path + use fpm_manifest, only : package_config_t, get_package_data + use fpm_toml, only: name_is_json + use fpm_model, only: fpm_model_t + use fpm, only: build_model + implicit none + private + public :: cmd_export + +contains + + !> Entry point for the export subcommand + subroutine cmd_export(settings) + !> Representation of the command line arguments + type(fpm_export_settings), intent(in) :: settings + type(package_config_t) :: package + type(dependency_tree_t) :: deps + type(fpm_model_t) :: model + type(error_t), allocatable :: error + + integer :: ii + character(len=:), allocatable :: filename + + if (len_trim(settings%dump_manifest)<=0 .and. & + len_trim(settings%dump_model)<=0 .and. & + len_trim(settings%dump_dependencies)<=0) then + call fpm_stop(0,'*cmd_export* exiting: no manifest/model/dependencies keyword provided') + end if + + !> Read in manifest + call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) + call handle_error(error) + + !> Export manifest + if (len_trim(settings%dump_manifest)>0) then + filename = trim(settings%dump_manifest) + call package%dump(filename, error, json=name_is_json(filename)) + end if + + !> Export dependency tree + if (len_trim(settings%dump_dependencies)>0) then + + !> Generate dependency tree + filename = join_path("build", "cache.toml") + call new_dependency_tree(deps, cache=filename, verbosity=merge(2, 1, settings%verbose)) + call deps%add(package, error) + call handle_error(error) + + !> Export dependency tree + filename = settings%dump_dependencies + call deps%dump(filename, error, json=name_is_json(filename)) + call handle_error(error) + end if + + !> Export full model + if (len_trim(settings%dump_model)>0) then + + call build_model(model, settings%fpm_build_settings, package, error) + if (allocated(error)) then + call fpm_stop(1,'*cmd_export* Model error: '//error%message) + end if + + filename = settings%dump_model + call model%dump(filename, error, json=name_is_json(filename)) + call handle_error(error) + end if + + end subroutine cmd_export + + !> Error handling for this command + subroutine handle_error(error) + !> Potential error + type(error_t), intent(in), optional :: error + if (present(error)) then + call fpm_stop(1, '*cmd_export* error: '//error%message) + end if + end subroutine handle_error + +end module fpm_cmd_export diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index 11ca717441..75353c6a6e 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -15,10 +15,10 @@ module fpm_cmd_update subroutine cmd_update(settings) !> Representation of the command line arguments type(fpm_update_settings), intent(in) :: settings + type(package_config_t) :: package type(dependency_tree_t) :: deps type(error_t), allocatable :: error - integer :: ii character(len=:), allocatable :: cache diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 26d7f56ad0..3fca2a48ab 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -743,7 +743,7 @@ subroutine dump_to_toml(self, table, error) !> Duplicate profile names are possible, as multiple profiles are possible with the !> same name, same compiler, etc. So, use a unique name here - write(profile_name,1) 'PROFILE',ii + write(profile_name,2) ii call add_table(ptr_pkg, trim(profile_name), ptr, error, class_name//'(profiles)') if (allocated(error)) return call pkg%dump_to_toml(ptr, error) @@ -842,6 +842,7 @@ subroutine dump_to_toml(self, table, error) end if 1 format('UNNAMED_',a,'_',i0) + 2 format('PROFILE_',i0) end subroutine dump_to_toml diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 8cd4776b75..6b545b5dce 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -44,6 +44,7 @@ module fpm_command_line public :: fpm_cmd_settings, & fpm_build_settings, & fpm_install_settings, & + fpm_export_settings, & fpm_new_settings, & fpm_run_settings, & fpm_test_settings, & @@ -108,9 +109,16 @@ module fpm_command_line !> Settings for interacting and updating with project dependencies type, extends(fpm_cmd_settings) :: fpm_update_settings character(len=ibug),allocatable :: name(:) - character(len=:),allocatable :: dump - logical :: fetch_only - logical :: clean + character(len=:),allocatable :: dump + logical :: fetch_only + logical :: clean +end type + +!> Settings for exporting model data +type, extends(fpm_build_settings) :: fpm_export_settings + character(len=:),allocatable :: dump_manifest + character(len=:),allocatable :: dump_dependencies + character(len=:),allocatable :: dump_model end type type, extends(fpm_cmd_settings) :: fpm_clean_settings @@ -221,6 +229,7 @@ subroutine get_command_line_settings(cmd_settings) logical :: is_unix type(fpm_install_settings), allocatable :: install_settings type(fpm_publish_settings), allocatable :: publish_settings + type(fpm_export_settings) , allocatable :: export_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & & c_compiler, cxx_compiler, archiver, version_s @@ -606,6 +615,38 @@ subroutine get_command_line_settings(cmd_settings) fetch_only=lget('fetch-only'), verbose=lget('verbose'), & clean=lget('clean')) + case('export') + + call set_args(common_args // compiler_args // '& + & --manifest "filename" & + & --model "filename" & + & --dependencies "filename" ', & + help_build, version_text) + + call check_build_vals() + + c_compiler = sget('c-compiler') + cxx_compiler = sget('cxx-compiler') + archiver = sget('archiver') + allocate(export_settings, source=fpm_export_settings(& + profile=val_profile,& + prune=.not.lget('no-prune'), & + compiler=val_compiler, & + c_compiler=c_compiler, & + cxx_compiler=cxx_compiler, & + archiver=archiver, & + flag=val_flag, & + cflag=val_cflag, & + show_model=.true., & + cxxflag=val_cxxflag, & + ldflag=val_ldflag, & + verbose=lget('verbose'))) + call get_char_arg(export_settings%dump_model, 'model') + call get_char_arg(export_settings%dump_manifest, 'manifest') + call get_char_arg(export_settings%dump_dependencies, 'dependencies') + call move_alloc(export_settings, cmd_settings) + + case('clean') call set_args(common_args // & & ' --skip' // & From ba27a3b785cfcf0531e2018a18f3bebcb42e8ad2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 18 May 2023 20:26:01 +0200 Subject: [PATCH 75/80] store `author`, `maintainer`, `copyright` metadata --- src/fpm/manifest/package.f90 | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 3fca2a48ab..57ab93110c 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -82,6 +82,15 @@ module fpm_manifest_package !> License meta data character(len=:), allocatable :: license + !> Author meta data + character(len=:), allocatable :: author + + !> Maintainer meta data + character(len=:), allocatable :: maintainer + + !> Copyright meta data + character(len=:), allocatable :: copyright + !> Library meta data type(library_config_t), allocatable :: library @@ -161,6 +170,9 @@ subroutine new_package(self, table, root, error) endif call get_value(table, "license", self%license) + call get_value(table, "author", self%author) + call get_value(table, "maintainer", self%maintainer) + call get_value(table, "copyright", self%copyright) if (len(self%name) <= 0) then call syntax_error(error, "Package name must be a non-empty string") @@ -532,6 +544,9 @@ logical function manifest_is_same(this,that) if (.not.this%install==other%install) return if (.not.this%fortran==other%fortran) return if (.not.this%license==other%license) return + if (.not.this%author==other%author) return + if (.not.this%maintainer==other%maintainer) return + if (.not.this%copyright==other%copyright) return if (allocated(this%library).neqv.allocated(other%library)) return if (allocated(this%library)) then if (.not.this%library==other%library) return @@ -619,6 +634,12 @@ subroutine dump_to_toml(self, table, error) if (allocated(error)) return call set_string(table, "license", self%license, error, class_name) if (allocated(error)) return + call set_string(table, "author", self%author, error, class_name) + if (allocated(error)) return + call set_string(table, "maintainer", self%maintainer, error, class_name) + if (allocated(error)) return + call set_string(table, "copyright", self%copyright, error, class_name) + if (allocated(error)) return call add_table(table, "build", ptr, error, class_name) if (allocated(error)) return @@ -867,6 +888,9 @@ subroutine load_from_toml(self, table, error) call get_value(table, "name", self%name) call get_value(table, "license", self%license) + call get_value(table, "author", self%author) + call get_value(table, "maintainer", self%maintainer) + call get_value(table, "copyright", self%copyright) call get_value(table, "version", flag) call new_version(self%version, flag, error) if (allocated(error)) then From 7999654a2ac9db4dff6ac362f8ef135364e500e8 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Wed, 20 Dec 2023 00:30:00 +0530 Subject: [PATCH 76/80] fix --- src/fpm/cmd/export.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/cmd/export.f90 b/src/fpm/cmd/export.f90 index 6386c8853a..d2ec0dbaf1 100644 --- a/src/fpm/cmd/export.f90 +++ b/src/fpm/cmd/export.f90 @@ -16,7 +16,7 @@ module fpm_cmd_export !> Entry point for the export subcommand subroutine cmd_export(settings) !> Representation of the command line arguments - type(fpm_export_settings), intent(in) :: settings + type(fpm_export_settings), intent(inout) :: settings type(package_config_t) :: package type(dependency_tree_t) :: deps type(fpm_model_t) :: model From 53a448668c1ae4ab52c8fd301ba480695186c5ca Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 10 Feb 2024 21:21:46 +0100 Subject: [PATCH 77/80] Sync `fpm_model` with `main` branch --- src/fpm_model.f90 | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 3a8d70df74..8663f33b6e 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -675,7 +675,7 @@ logical function package_is_same(this,that) end do end if - if (.not.(this%macros==other%macros)) return + if (.not.(this%preprocess==other%preprocess)) return if (.not.(this%version==other%version)) return !> Module naming @@ -723,7 +723,10 @@ subroutine package_dump_to_toml(self, table, error) call set_string(table, "module-prefix", self%module_prefix, error, 'package_t') if (allocated(error)) return - call set_list(table, "macros", self%macros, error) + !> Create a preprocessor table + call add_table(table, "preprocess", ptr, error, 'package_t') + if (allocated(error)) return + call self%preprocess%dump_to_toml(ptr, error) if (allocated(error)) return !> Create a fortran table @@ -768,7 +771,7 @@ subroutine package_load_from_toml(self, table, error) integer :: ierr,ii,jj type(toml_key), allocatable :: keys(:),src_keys(:) - type(toml_table), pointer :: ptr_sources,ptr,ptr_fortran + type(toml_table), pointer :: ptr_sources,ptr,ptr_fortran,ptr_preprocess type(error_t), allocatable :: new_error call get_value(table, "name", self%name) @@ -780,9 +783,6 @@ subroutine package_load_from_toml(self, table, error) ! Return unallocated value if not present call get_value(table, "module-prefix", self%module_prefix%s) - call get_list(table, "macros", self%macros, error) - if (allocated(error)) return - ! Sources call table%get_keys(keys) @@ -799,6 +799,17 @@ subroutine package_load_from_toml(self, table, error) call self%features%load_from_toml(ptr_fortran,error) if (allocated(error)) return + case ("preprocess") + + call get_value(table, keys(ii), ptr_preprocess) + if (.not.associated(ptr_preprocess)) then + call fatal_error(error,'package_t: error retrieving preprocess table from TOML table') + return + end if + + call self%preprocess%load_from_toml(ptr_preprocess,error) + if (allocated(error)) return + case ("sources") call get_value(table, keys(ii), ptr_sources) From ecd23ed414183e8e63ce7db72945e8988046fa61 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 10 Feb 2024 21:41:30 +0100 Subject: [PATCH 78/80] `ifx` issue test: rename `toml_table` in `fpm_settings` --- src/.fpm_settings.f90.swp | Bin 0 -> 16384 bytes src/fpm_settings.f90 | 8 ++++---- 2 files changed, 4 insertions(+), 4 deletions(-) create mode 100644 src/.fpm_settings.f90.swp diff --git a/src/.fpm_settings.f90.swp b/src/.fpm_settings.f90.swp new file mode 100644 index 0000000000000000000000000000000000000000..6a0fbdc02c709092119614a6a146ffe47a105851 GIT binary patch literal 16384 zcmeHNON=B(5iQ&J!`h4a2qA=#a%O3FHyT$j7zsRP77bqSdToXsuXmTrNIlinS<}T- zSC%TXW_ElqG6xIe6XJ70{3P=c7tB`%Uyu+S&4mNPLgIpCA;AF-2nhr)GArxXpII+R z2vIG)o$c<-$jFxwkr7cnI(_xR7JI-w?cnuB$LYAwkDuNg-TeJW9Vg&po`$}lua>>e z<>TaiTOZzbgEUl6x+8IIX3A4m;NYzAvnh|29Gnl;BiU#WB-4RRefm3;T&XbLlWy>U z)@nvh`$5Y<%fO8=aMHQ|z3mE7Wd0=nOv>;FXl_ol|*f99`I{`uv`_qXKlKa~IdQRDmkZTqKXpk<(Cpk<(C zpk<(Cpk<(Cpk<(Cpk<(Cpk?5{z<@W#Gk>i6EEW8C{%`C57w>kQ=Yhw7Q@~%};5c6b z-Ur+doC4kseD|c|yZ}4_oCNLy{&bh)d;CTfhn6mDfAY_ka-S0e`;3aee`O0eBAhH1IU=2yi#>>g|s6E#Mj8ap0}MA8x}O z;Pb%efHANQTm;?({PtGp4n%+h{N;662lyHAEYJt;0p0=p3Js1=0z=>`&;jlMzKzDo zSAa)>4d8>oJAqfg=WhVw^;5*{aWAG{D{M1Kq9ZouftN*!rF<`xDm`NMM-j}6$M{rb zY0Sca`63R&Jr;x!XJf%-+*OQU!xYzXjKsZ2jJ&A$QANkh7}AVk>`gh_u!{|wU*!^3 z*cA!sxkh>^npmvBp-~v*gBfcsn0RV3RHBeBBK)cZtA1RB@sPgk?Qu1Xgbyu~ln3Fp zUVn{s@k@|yKNrd)$^X;x<-|*Qx3Lfy?Fl&yIoI4Nvs#q78M`&c$$h7qRlDh!m;~^PV<1LirDf-Qbd{JIYW&@oXhDNGm;B+ zx4eDMWR`O5!c(*rrnOc=|KA)`&4fb9?81wVS1THL3a6!)Guv5XtLMlDW1(0evUt4C zx~qdh(-wj(!XeX{_XmU3uDjZQuucOpA=8yGDcA%NjUj5bM}cyj1xQi-YdI~9t!X6we|&4`-GRKpDf z8{20U!`HSK#)|L3$Jf`HRG!kGsiTDVuwXP)-YDYm@C5#^%qSb>%y%Yol@p9rud&>N zXgY~byi{^ygL;LPGwfmVEd2$3KgM9@moIL8gy{v1PnJTh77d~LV=JzlO|nMXoFYDE zhap_Q?mad8k9Kztc`^AZPAZc)Cnd0h2~12M z*e?0iu3-|o?shh}x6f`~-t6q?yJrW)?u>Z?9eC`AT<$UvvyX-GSRBe?mhm%0Nd(p1 zrv|Q`I?#8C{te@dfGfC1=+3q(UTy?oy$OU&x)fb@A3RHI|C zx@r2%K^6)ehPVms5yCJO+<^%b&l}q0$xsq`K9@w5mD^<5tW)fjc+Q=Yj}6E55s*W6 zNLEJvW+xU|)Qqtvsqp!ju3Ai)6JFO?arGhcfq|KfXeiPlpC;-EYZpGj@X|4Bt`@T{ zF{>y^fVE$;d87#{xj`TAVmiGnlSL;N_fbk5^D{9Kq863Vx6$GsgZ|k4E~CgxI0lQk?VtjJ;(dJB$O_4LZ3&jmn2=%G08?z=v&)tY+`L* z)HWYlp@kK%;RsDgnAL{XNy7sqtoUCzO|T+v`&h)BR6uyujv*vu#L>~ZUe(Xi6nEQj z9H!h?B0X9oKI1)J{e&(Rn`7!!5Q7$^y_JQ?a_mxN76I3#j6&a``Tr^5Fxx%wqKxOC zM#6)iOsuy?8hpWgCfin=q`?cpT!C;Enh$|o*bOZ7k1y|<$truyGLzkeAu|JQ*X;BjCZxEJ_6YW|mitH1@|46p%EFW}dx{a*xj z0qO@_0y@B}=mC5K_#$uyxC!_v>i%8eLBIuW1ztwo|0E!Q5SRe(0{)2l|0lqYflC1O z171SS|3lyhz%#%O&J4%Z}YoXFF zTRhk{Mf9XHbz4v`&RwtAh>;O_QugSgZKPGz5?j~pq!gwkl=25z>{Acrn8dzEbEu_> zySrJS)RWjEfpYUgLo1hZNiE@O=X5bO#lEPSs)v~zwan%FB)gjNE}+dUYsS7-dJ1NW z>c^0PdXo0iGk+?a&^S%w;_SZ0$(&LP1Ysvbm4;Kj*nB(dvoq{8b5WVQjo~vq(MY|0 zGE38(oU?4LpF8J!s8y7lOZ753HO9^;l^@<~JrEvo%3jd~h{Rrqre|rqb9Am*Y?^V~ zR;^pBZnC1vqt;8_X128-<+tP+wKJnGPZ3>MnG!d9OY;w|X4u_ozomFw(D2>POySch zTSqvSd-dT`_|nZ%bHXM66gF(2fxqC@*g!p6=@J6tYu$ag83gJgsaE^+N<~l*G@AU& z)UNd1j7}@;JUTJHhYF336-~$d0fO-+1gDWe&1~CI^~M&7D2?0HDizhR8?C;sMyj7X zW^LM?ZN=5XQ*%elBQQm(QqXlh`&mX2G%2MOn*JNxq^Zpkt;$CJuqa=uVI-QsN>y1r zHaRP_rTDxbZd3caJ0v14$eG6Dpy_nIE9LSHrO!T0D9Ar znU9vBtUbRgTu^rgdb-t*=YQn_cp6x~!L12F8}yGcMIuAb=}@FZ7ok_3x|out6WC1_ ZwS31kf0p)QOnOyu(q*T9y(?0a_+LZ0xc&eD literal 0 HcmV?d00001 diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index fe4b0748fa..a2ade1e592 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -3,7 +3,7 @@ module fpm_settings use fpm_filesystem, only: exists, join_path, get_local_prefix, is_absolute_path, mkdir use fpm_environment, only: os_is_unix use fpm_error, only: error_t, fatal_error - use fpm_toml, only: toml_table, toml_error, toml_stat, get_value, toml_load, check_keys + use fpm_toml, only: ttable=>toml_table, toml_error, toml_stat, get_value, toml_load, check_keys use fpm_os, only: get_current_directory, change_directory, get_absolute_path, convert_to_absolute_path implicit none @@ -47,11 +47,11 @@ subroutine get_global_settings(global_settings, error) !> Error reading config file. type(error_t), allocatable, intent(out) :: error !> TOML table to be filled with global config settings. - type(toml_table), allocatable :: table + type(ttable), allocatable :: table !> Error parsing to TOML table. type(toml_error), allocatable :: parse_error - type(toml_table), pointer :: registry_table + type(ttable), pointer :: registry_table integer :: stat ! Use custom path to the config file if it was specified. @@ -122,7 +122,7 @@ subroutine use_default_registry_settings(global_settings) !> Read registry settings from the global config file. subroutine get_registry_settings(table, global_settings, error) !> The [registry] subtable from the global config file. - type(toml_table), target, intent(inout) :: table + type(ttable), target, intent(inout) :: table !> The global settings which can be filled with the registry settings. type(fpm_global_settings), intent(inout) :: global_settings !> Error handling. From becfa63b0e951a427f9ea56fd2660b020fa4031c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 11 Feb 2024 09:54:10 +0100 Subject: [PATCH 79/80] Revert "`ifx` issue test: rename `toml_table` in `fpm_settings`" This reverts commit ecd23ed414183e8e63ce7db72945e8988046fa61. --- src/.fpm_settings.f90.swp | Bin 16384 -> 0 bytes src/fpm_settings.f90 | 8 ++++---- 2 files changed, 4 insertions(+), 4 deletions(-) delete mode 100644 src/.fpm_settings.f90.swp diff --git a/src/.fpm_settings.f90.swp b/src/.fpm_settings.f90.swp deleted file mode 100644 index 6a0fbdc02c709092119614a6a146ffe47a105851..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16384 zcmeHNON=B(5iQ&J!`h4a2qA=#a%O3FHyT$j7zsRP77bqSdToXsuXmTrNIlinS<}T- zSC%TXW_ElqG6xIe6XJ70{3P=c7tB`%Uyu+S&4mNPLgIpCA;AF-2nhr)GArxXpII+R z2vIG)o$c<-$jFxwkr7cnI(_xR7JI-w?cnuB$LYAwkDuNg-TeJW9Vg&po`$}lua>>e z<>TaiTOZzbgEUl6x+8IIX3A4m;NYzAvnh|29Gnl;BiU#WB-4RRefm3;T&XbLlWy>U z)@nvh`$5Y<%fO8=aMHQ|z3mE7Wd0=nOv>;FXl_ol|*f99`I{`uv`_qXKlKa~IdQRDmkZTqKXpk<(Cpk<(C zpk<(Cpk<(Cpk<(Cpk<(Cpk?5{z<@W#Gk>i6EEW8C{%`C57w>kQ=Yhw7Q@~%};5c6b z-Ur+doC4kseD|c|yZ}4_oCNLy{&bh)d;CTfhn6mDfAY_ka-S0e`;3aee`O0eBAhH1IU=2yi#>>g|s6E#Mj8ap0}MA8x}O z;Pb%efHANQTm;?({PtGp4n%+h{N;662lyHAEYJt;0p0=p3Js1=0z=>`&;jlMzKzDo zSAa)>4d8>oJAqfg=WhVw^;5*{aWAG{D{M1Kq9ZouftN*!rF<`xDm`NMM-j}6$M{rb zY0Sca`63R&Jr;x!XJf%-+*OQU!xYzXjKsZ2jJ&A$QANkh7}AVk>`gh_u!{|wU*!^3 z*cA!sxkh>^npmvBp-~v*gBfcsn0RV3RHBeBBK)cZtA1RB@sPgk?Qu1Xgbyu~ln3Fp zUVn{s@k@|yKNrd)$^X;x<-|*Qx3Lfy?Fl&yIoI4Nvs#q78M`&c$$h7qRlDh!m;~^PV<1LirDf-Qbd{JIYW&@oXhDNGm;B+ zx4eDMWR`O5!c(*rrnOc=|KA)`&4fb9?81wVS1THL3a6!)Guv5XtLMlDW1(0evUt4C zx~qdh(-wj(!XeX{_XmU3uDjZQuucOpA=8yGDcA%NjUj5bM}cyj1xQi-YdI~9t!X6we|&4`-GRKpDf z8{20U!`HSK#)|L3$Jf`HRG!kGsiTDVuwXP)-YDYm@C5#^%qSb>%y%Yol@p9rud&>N zXgY~byi{^ygL;LPGwfmVEd2$3KgM9@moIL8gy{v1PnJTh77d~LV=JzlO|nMXoFYDE zhap_Q?mad8k9Kztc`^AZPAZc)Cnd0h2~12M z*e?0iu3-|o?shh}x6f`~-t6q?yJrW)?u>Z?9eC`AT<$UvvyX-GSRBe?mhm%0Nd(p1 zrv|Q`I?#8C{te@dfGfC1=+3q(UTy?oy$OU&x)fb@A3RHI|C zx@r2%K^6)ehPVms5yCJO+<^%b&l}q0$xsq`K9@w5mD^<5tW)fjc+Q=Yj}6E55s*W6 zNLEJvW+xU|)Qqtvsqp!ju3Ai)6JFO?arGhcfq|KfXeiPlpC;-EYZpGj@X|4Bt`@T{ zF{>y^fVE$;d87#{xj`TAVmiGnlSL;N_fbk5^D{9Kq863Vx6$GsgZ|k4E~CgxI0lQk?VtjJ;(dJB$O_4LZ3&jmn2=%G08?z=v&)tY+`L* z)HWYlp@kK%;RsDgnAL{XNy7sqtoUCzO|T+v`&h)BR6uyujv*vu#L>~ZUe(Xi6nEQj z9H!h?B0X9oKI1)J{e&(Rn`7!!5Q7$^y_JQ?a_mxN76I3#j6&a``Tr^5Fxx%wqKxOC zM#6)iOsuy?8hpWgCfin=q`?cpT!C;Enh$|o*bOZ7k1y|<$truyGLzkeAu|JQ*X;BjCZxEJ_6YW|mitH1@|46p%EFW}dx{a*xj z0qO@_0y@B}=mC5K_#$uyxC!_v>i%8eLBIuW1ztwo|0E!Q5SRe(0{)2l|0lqYflC1O z171SS|3lyhz%#%O&J4%Z}YoXFF zTRhk{Mf9XHbz4v`&RwtAh>;O_QugSgZKPGz5?j~pq!gwkl=25z>{Acrn8dzEbEu_> zySrJS)RWjEfpYUgLo1hZNiE@O=X5bO#lEPSs)v~zwan%FB)gjNE}+dUYsS7-dJ1NW z>c^0PdXo0iGk+?a&^S%w;_SZ0$(&LP1Ysvbm4;Kj*nB(dvoq{8b5WVQjo~vq(MY|0 zGE38(oU?4LpF8J!s8y7lOZ753HO9^;l^@<~JrEvo%3jd~h{Rrqre|rqb9Am*Y?^V~ zR;^pBZnC1vqt;8_X128-<+tP+wKJnGPZ3>MnG!d9OY;w|X4u_ozomFw(D2>POySch zTSqvSd-dT`_|nZ%bHXM66gF(2fxqC@*g!p6=@J6tYu$ag83gJgsaE^+N<~l*G@AU& z)UNd1j7}@;JUTJHhYF336-~$d0fO-+1gDWe&1~CI^~M&7D2?0HDizhR8?C;sMyj7X zW^LM?ZN=5XQ*%elBQQm(QqXlh`&mX2G%2MOn*JNxq^Zpkt;$CJuqa=uVI-QsN>y1r zHaRP_rTDxbZd3caJ0v14$eG6Dpy_nIE9LSHrO!T0D9Ar znU9vBtUbRgTu^rgdb-t*=YQn_cp6x~!L12F8}yGcMIuAb=}@FZ7ok_3x|out6WC1_ ZwS31kf0p)QOnOyu(q*T9y(?0a_+LZ0xc&eD diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index a2ade1e592..fe4b0748fa 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -3,7 +3,7 @@ module fpm_settings use fpm_filesystem, only: exists, join_path, get_local_prefix, is_absolute_path, mkdir use fpm_environment, only: os_is_unix use fpm_error, only: error_t, fatal_error - use fpm_toml, only: ttable=>toml_table, toml_error, toml_stat, get_value, toml_load, check_keys + use fpm_toml, only: toml_table, toml_error, toml_stat, get_value, toml_load, check_keys use fpm_os, only: get_current_directory, change_directory, get_absolute_path, convert_to_absolute_path implicit none @@ -47,11 +47,11 @@ subroutine get_global_settings(global_settings, error) !> Error reading config file. type(error_t), allocatable, intent(out) :: error !> TOML table to be filled with global config settings. - type(ttable), allocatable :: table + type(toml_table), allocatable :: table !> Error parsing to TOML table. type(toml_error), allocatable :: parse_error - type(ttable), pointer :: registry_table + type(toml_table), pointer :: registry_table integer :: stat ! Use custom path to the config file if it was specified. @@ -122,7 +122,7 @@ subroutine use_default_registry_settings(global_settings) !> Read registry settings from the global config file. subroutine get_registry_settings(table, global_settings, error) !> The [registry] subtable from the global config file. - type(ttable), target, intent(inout) :: table + type(toml_table), target, intent(inout) :: table !> The global settings which can be filled with the registry settings. type(fpm_global_settings), intent(inout) :: global_settings !> Error handling. From 8dc701578e7c0325d0528f81ae8890e4993bb1e2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 11 Feb 2024 09:57:07 +0100 Subject: [PATCH 80/80] Intel CI: build `fpm` with gfortran, build tests with ifx --- .github/workflows/meta.yml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index be6a46dcb9..cf915f31b2 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -84,7 +84,7 @@ jobs: Remove-Item "oneAPI" -Force -Recurse - name: (Ubuntu) Install gfortran - if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) + if: contains(matrix.os,'ubuntu') run: | sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ @@ -209,14 +209,6 @@ jobs: mv $(which fpm) fpm-bootstrap${{ matrix.exe }} echo "BOOTSTRAP=$PWD/fpm-bootstrap" >> $GITHUB_ENV - - name: Use Intel compiler for the metapackage tests - if: contains(matrix.mpi,'intel') - shell: bash - run: | - echo "FPM_FC=ifx" >> $GITHUB_ENV - echo "FPM_CC=icx" >> $GITHUB_ENV - echo "FPM_CXX=icpx" >> $GITHUB_ENV - - name: (macOS) Use gcc/g++ instead of Clang for C/C++ if: contains(matrix.os,'macOS') shell: bash @@ -300,6 +292,14 @@ jobs: env: EXE: fpm-${{ env.VERSION }}-${{ matrix.os-arch }}${{ matrix.exe }} + - name: Use Intel compiler for the metapackage tests + if: contains(matrix.mpi,'intel') + shell: bash + run: | + echo "FPM_FC=ifx" >> $GITHUB_ENV + echo "FPM_CC=icx" >> $GITHUB_ENV + echo "FPM_CXX=icpx" >> $GITHUB_ENV + - name: Run metapackage tests using the release version shell: bash run: |