Skip to content

Commit a7cb2a0

Browse files
perazzperazz
committed
Revert "Revert "partial profile_config_t""
This reverts commit fa8c98e.
1 parent fa8c98e commit a7cb2a0

File tree

3 files changed

+172
-15
lines changed

3 files changed

+172
-15
lines changed

‎src/fpm/manifest/profiles.f90

Lines changed: 150 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -43,10 +43,11 @@
4343
!>
4444
module fpm_manifest_profile
4545
use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop
46-
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string
46+
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, &
47+
set_string, add_table
4748
use fpm_strings, only: lower
4849
use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
49-
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
50+
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME
5051
use fpm_filesystem, only: join_path
5152
implicit none
5253
public :: profile_config_t, new_profile, new_profiles, get_default_profiles, &
@@ -76,7 +77,7 @@ module fpm_manifest_profile
7677
end type file_scope_flag
7778

7879
!> Configuration meta data for a profile
79-
type :: profile_config_t
80+
type, extends(serializable_t) :: profile_config_t
8081
!> Name of the profile
8182
character(len=:), allocatable :: profile_name
8283

@@ -109,6 +110,11 @@ module fpm_manifest_profile
109110
!> Print information on this instance
110111
procedure :: info
111112

113+
!> Serialization interface
114+
procedure :: serializable_is_same => profile_same
115+
procedure :: dump_to_toml => profile_dump
116+
procedure :: load_from_toml => profile_load
117+
112118
end type profile_config_t
113119

114120
contains
@@ -1026,6 +1032,147 @@ subroutine file_scope_load(self, table, error)
10261032

10271033
end subroutine file_scope_load
10281034

1035+
logical function profile_same(this,that)
1036+
class(profile_config_t), intent(in) :: this
1037+
class(serializable_t), intent(in) :: that
1038+
1039+
integer :: ii
1040+
1041+
profile_same = .false.
1042+
1043+
select type (other=>that)
1044+
type is (profile_config_t)
1045+
if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return
1046+
if (allocated(this%profile_name)) then
1047+
if (.not.(this%profile_name==other%profile_name)) return
1048+
endif
1049+
if (allocated(this%compiler).neqv.allocated(other%compiler)) return
1050+
if (allocated(this%compiler)) then
1051+
if (.not.(this%compiler==other%compiler)) return
1052+
endif
1053+
if (this%os_type/=other%os_type) return
1054+
if (allocated(this%flags).neqv.allocated(other%flags)) return
1055+
if (allocated(this%flags)) then
1056+
if (.not.(this%flags==other%flags)) return
1057+
endif
1058+
if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return
1059+
if (allocated(this%c_flags)) then
1060+
if (.not.(this%c_flags==other%c_flags)) return
1061+
endif
1062+
if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return
1063+
if (allocated(this%cxx_flags)) then
1064+
if (.not.(this%cxx_flags==other%cxx_flags)) return
1065+
endif
1066+
if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return
1067+
if (allocated(this%link_time_flags)) then
1068+
if (.not.(this%link_time_flags==other%link_time_flags)) return
1069+
endif
1070+
1071+
if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return
1072+
if (allocated(this%file_scope_flags)) then
1073+
if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return
1074+
do ii=1,size(this%file_scope_flags)
1075+
if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return
1076+
end do
1077+
endif
1078+
1079+
if (this%is_built_in.neqv.other%is_built_in) return
1080+
1081+
class default
1082+
! Not the same type
1083+
return
1084+
end select
1085+
1086+
!> All checks passed!
1087+
profile_same = .true.
1088+
1089+
end function profile_same
1090+
1091+
!> Dump to toml table
1092+
subroutine profile_dump(self, table, error)
1093+
1094+
!> Instance of the serializable object
1095+
class(profile_config_t), intent(inout) :: self
1096+
1097+
!> Data structure
1098+
type(toml_table), intent(inout) :: table
1099+
1100+
!> Error handling
1101+
type(error_t), allocatable, intent(out) :: error
1102+
1103+
!> Local variables
1104+
integer :: ierr, ii
1105+
type(toml_table), pointer :: ptr_deps, ptr
1106+
character(len=30) :: unnamed
1107+
1108+
call set_string(table, "profile-name", self%profile_name, error)
1109+
if (allocated(error)) return
1110+
call set_string(table, "compiler", self%compiler, error)
1111+
if (allocated(error)) return
1112+
call set_string(table,"os-type",OS_NAME(self%os_type), error, 'profile_config_t')
1113+
if (allocated(error)) return
1114+
call set_string(table, "flags", self%flags, error)
1115+
if (allocated(error)) return
1116+
call set_string(table, "c-flags", self%c_flags, error)
1117+
if (allocated(error)) return
1118+
call set_string(table, "cxx-flags", self%cxx_flags, error)
1119+
if (allocated(error)) return
1120+
call set_string(table, "link-time-flags", self%link_time_flags, error)
1121+
if (allocated(error)) return
1122+
1123+
if (allocated(self%file_scope_flags)) then
1124+
1125+
! Create dependency table
1126+
call add_table(table, "file-scope-flags", ptr_deps)
1127+
if (.not. associated(ptr_deps)) then
1128+
call fatal_error(error, "profile_config_t cannot create file scope table ")
1129+
return
1130+
end if
1131+
1132+
do ii = 1, size(self%file_scope_flags)
1133+
associate (dep => self%file_scope_flags(ii))
1134+
1135+
!> Because files need a name, fallback if this has no name
1136+
if (len_trim(dep%file_name)==0) then
1137+
write(unnamed,1) ii
1138+
call add_table(ptr_deps, trim(unnamed), ptr)
1139+
else
1140+
call add_table(ptr_deps, dep%file_name, ptr)
1141+
end if
1142+
if (.not. associated(ptr)) then
1143+
call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name)
1144+
return
1145+
end if
1146+
call dep%dump_to_toml(ptr, error)
1147+
if (allocated(error)) return
1148+
end associate
1149+
end do
1150+
1151+
endif
1152+
1153+
call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t')
1154+
if (allocated(error)) return
1155+
1156+
1 format('UNNAMED_FILE_',i0)
1157+
1158+
end subroutine profile_dump
1159+
1160+
!> Read from toml table (no checks made at this stage)
1161+
subroutine profile_load(self, table, error)
1162+
1163+
!> Instance of the serializable object
1164+
class(profile_config_t), intent(inout) :: self
1165+
1166+
!> Data structure
1167+
type(toml_table), intent(inout) :: table
1168+
1169+
!> Error handling
1170+
type(error_t), allocatable, intent(out) :: error
1171+
1172+
! call get_value(table, "file-name", self%profile_name)
1173+
! call get_value(table, "flags", self%flags)
1174+
1175+
end subroutine profile_load
10291176

10301177

10311178
end module fpm_manifest_profile

‎src/fpm_command_line.f90

Lines changed: 2 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@
2525
module fpm_command_line
2626
use fpm_environment, only : get_os_type, get_env, os_is_unix, &
2727
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
28-
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
28+
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME
2929
use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
3030
use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE
3131
use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name
@@ -234,17 +234,7 @@ subroutine get_command_line_settings(cmd_settings)
234234
call set_help()
235235
os = get_os_type()
236236
! text for --version switch,
237-
select case (os)
238-
case (OS_LINUX); os_type = "OS Type: Linux"
239-
case (OS_MACOS); os_type = "OS Type: macOS"
240-
case (OS_WINDOWS); os_type = "OS Type: Windows"
241-
case (OS_CYGWIN); os_type = "OS Type: Cygwin"
242-
case (OS_SOLARIS); os_type = "OS Type: Solaris"
243-
case (OS_FREEBSD); os_type = "OS Type: FreeBSD"
244-
case (OS_OPENBSD); os_type = "OS Type: OpenBSD"
245-
case (OS_UNKNOWN); os_type = "OS Type: Unknown"
246-
case default ; os_type = "OS Type: UNKNOWN"
247-
end select
237+
os_type = "OS Type: "//OS_NAME(os)
248238
is_unix = os_is_unix(os)
249239

250240
! Get current release version

‎src/fpm_environment.f90

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module fpm_environment
1515
public :: get_command_arguments_quoted
1616
public :: separator
1717

18+
public :: OS_NAME
1819
integer, parameter, public :: OS_UNKNOWN = 0
1920
integer, parameter, public :: OS_LINUX = 1
2021
integer, parameter, public :: OS_MACOS = 2
@@ -24,6 +25,25 @@ module fpm_environment
2425
integer, parameter, public :: OS_FREEBSD = 6
2526
integer, parameter, public :: OS_OPENBSD = 7
2627
contains
28+
29+
!> Return string describing the OS type flag
30+
pure function OS_NAME(os)
31+
integer, intent(in) :: os
32+
character(len=:), allocatable :: OS_NAME
33+
34+
select case (os)
35+
case (OS_LINUX); OS_NAME = "Linux"
36+
case (OS_MACOS); OS_NAME = "macOS"
37+
case (OS_WINDOWS); OS_NAME = "Windows"
38+
case (OS_CYGWIN); OS_NAME = "Cygwin"
39+
case (OS_SOLARIS); OS_NAME = "Solaris"
40+
case (OS_FREEBSD); OS_NAME = "FreeBSD"
41+
case (OS_OPENBSD); OS_NAME = "OpenBSD"
42+
case (OS_UNKNOWN); OS_NAME = "Unknown"
43+
case default ; OS_NAME = "UNKNOWN"
44+
end select
45+
end function OS_NAME
46+
2747
!> Determine the OS type
2848
integer function get_os_type() result(r)
2949
!!

0 commit comments

Comments
 (0)