From 84bf69a331de4d2984adca310409d34f902073c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 9 Dec 2020 13:31:37 -0700 Subject: Add str() to convert int/real/logical to strings --- fpm/src/fpm_strings.f90 | 93 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 92 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 8e57d5b..ad0a843 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -5,7 +5,9 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t public :: string_array_contains, string_cat, operator(.in.), fnv_1a -public :: resize +public :: resize, str + +integer, parameter :: dp = selected_real_kind(15) type string_t character(len=:), allocatable :: s @@ -29,6 +31,10 @@ interface str_ends_with procedure :: str_ends_with_any end interface str_ends_with +interface str + module procedure str_int, str_int64, str_real, str_real_n, str_logical +end interface + contains pure logical function str_ends_with_str(s, e) result(r) @@ -349,4 +355,89 @@ subroutine resize_string(list, n) end subroutine resize_string +pure integer function str_int_len(i) result(sz) +! Returns the length of the string representation of 'i' +integer, intent(in) :: i +integer, parameter :: MAX_STR = 100 +character(MAX_STR) :: s +! If 's' is too short (MAX_STR too small), Fortran will abort with: +! "Fortran runtime error: End of record" +write(s, '(i0)') i +sz = len_trim(s) +end function + +pure function str_int(i) result(s) +! Converts integer "i" to string +integer, intent(in) :: i +character(len=str_int_len(i)) :: s +write(s, '(i0)') i +end function + +pure integer function str_int64_len(i) result(sz) +! Returns the length of the string representation of 'i' +integer(int64), intent(in) :: i +integer, parameter :: MAX_STR = 100 +character(MAX_STR) :: s +! If 's' is too short (MAX_STR too small), Fortran will abort with: +! "Fortran runtime error: End of record" +write(s, '(i0)') i +sz = len_trim(s) +end function + +pure function str_int64(i) result(s) +! Converts integer "i" to string +integer(int64), intent(in) :: i +character(len=str_int64_len(i)) :: s +write(s, '(i0)') i +end function + +pure integer function str_real_len(r, fmt) result(sz) +! Returns the length of the string representation of 'i' +real(dp), intent(in) :: r +character(len=*), intent(in) :: fmt +integer, parameter :: MAX_STR = 100 +character(MAX_STR) :: s +! If 's' is too short (MAX_STR too small), Fortan will abort with: +! "Fortran runtime error: End of record" +write(s, fmt) r +sz = len_trim(s) +end function + +pure function str_real(r) result(s) +! Converts the real number "r" to string with 7 decimal digits. +real(dp), intent(in) :: r +character(len=*), parameter :: fmt="(f0.6)" +character(len=str_real_len(r, fmt)) :: s +write(s, fmt) r +end function + +pure function str_real_n(r, n) result(s) +! Converts the real number "r" to string with 'n' decimal digits. +real(dp), intent(in) :: r +integer, intent(in) :: n +character(len=str_real_len(r, "(f0." // str_int(n) // ")")) :: s +write(s, "(f0." // str_int(n) // ")") r +end function + +pure integer function str_logical_len(l) result(sz) +! Returns the length of the string representation of 'l' +logical, intent(in) :: l +if (l) then + sz = 6 +else + sz = 7 +end if +end function + +pure function str_logical(l) result(s) +! Converts logical "l" to string +logical, intent(in) :: l +character(len=str_logical_len(l)) :: s +if (l) then + s = ".true." +else + s = ".false." +end if +end function + end module fpm_strings -- cgit v1.2.3 From 5150bf66964c800a0e65b404f5c3722baad295dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 9 Dec 2020 13:09:47 -0700 Subject: Add a `--show-model` option to `build` --- fpm/src/fpm.f90 | 4 +- fpm/src/fpm_command_line.f90 | 16 ++-- fpm/src/fpm_model.f90 | 172 ++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 183 insertions(+), 9 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index d91b1d4..3a1c27c 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -9,7 +9,7 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, & - FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE + FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, show_model use fpm_compiler, only: add_compile_flag_defaults @@ -199,6 +199,8 @@ if(settings%list)then do i=1,size(model%targets) write(stderr,*) model%targets(i)%ptr%output_file enddo +else if (settings%show_model) then + call show_model(model) else call build_package(model) endif diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index a733fc2..f7cd38f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -59,6 +59,7 @@ end type type, extends(fpm_cmd_settings) :: fpm_build_settings logical :: list=.false. + logical :: show_model=.false. character(len=:),allocatable :: compiler character(len=:),allocatable :: build_name end type @@ -184,6 +185,7 @@ contains call set_args( '& & --release F & & --list F & + & --show-model F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --verbose F& & --',help_build,version_text) @@ -195,6 +197,7 @@ contains & build_name=val_build,& & compiler=val_compiler, & & list=lget('list'),& + & show_model=lget('show-model'),& & verbose=lget('verbose') ) case('new') @@ -737,14 +740,15 @@ contains ' specified in the "fpm.toml" file. ', & ' ', & 'OPTIONS ', & - ' --release build in build/*_release instead of build/*_debug with ', & - ' high optimization instead of full debug options. ', & - ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & + ' --release build in build/*_release instead of build/*_debug with ', & + ' high optimization instead of full debug options. ', & + ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & ' "gfortran" unless set by the environment ', & ' variable FPM_COMPILER. ', & - ' --list list candidates instead of building or running them ', & - ' --help print this help and exit ', & - ' --version print program version information and exit ', & + ' --list list candidates instead of building or running them ', & + ' --show-model show the model and exit (do not build) ', & + ' --help print this help and exit ', & + ' --version print program version information and exit ', & ' ', & 'EXAMPLES ', & ' Sample commands: ', & diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index b7d97db..72c0b04 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -26,12 +26,13 @@ !> module fpm_model use iso_fortran_env, only: int64 -use fpm_strings, only: string_t +use fpm_strings, only: string_t, str use fpm_dependency, only: dependency_tree_t implicit none private -public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr +public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr, & + show_model public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & @@ -194,4 +195,171 @@ type :: fpm_model_t end type fpm_model_t +contains + +recursive function info_build_target(t) result(s) +type(build_target_t), intent(in) :: t +character(:), allocatable :: s +integer :: i +!type build_target_t +s = "build_target_t(" +! character(:), allocatable :: output_file +s = s // 'output_file="' // t%output_file // '"' +! type(srcfile_t), allocatable :: source +if (allocated(t%source)) then + s = s // ", source=" // info_srcfile(t%source) +else + s = s // ", source=()" +end if +! type(build_target_ptr), allocatable :: dependencies(:) +s = s // ", dependencies=[" +if (allocated(t%dependencies)) then + do i = 1, size(t%dependencies) + ! TODO: This compiles, but it hangs at runtime due to infinite + ! recursion, so for now we just print "..." + !s = s // info_build_target(t%dependencies(i)%ptr) + s = s // "build_target_t(...)" + if (i < size(t%dependencies)) s = s // ", " + end do +end if +s = s // "]" +! integer :: target_type = FPM_TARGET_UNKNOWN +s = s // ", target_type=" // str(t%target_type) +! type(string_t), allocatable :: link_libraries(:) +s = s // ", link_libraries=[" +if (allocated(t%link_libraries)) then + do i = 1, size(t%link_libraries) + s = s // '"' // t%link_libraries(i)%s // '"' + if (i < size(t%link_libraries)) s = s // ", " + end do +end if +s = s // "]" +! type(string_t), allocatable :: link_objects(:) +s = s // ", link_objects=[" +if (allocated(t%link_objects)) then + do i = 1, size(t%link_objects) + s = s // '"' // t%link_objects(i)%s // '"' + if (i < size(t%link_objects)) s = s // ", " + end do +end if +s = s // "]" +! logical :: touched = .false. +s = s // ", touched=" // str(t%touched) +! logical :: sorted = .false. +s = s // ", sorted=" // str(t%sorted) +! logical :: skip = .false. +s = s // ", skip=" // str(t%skip) +! integer :: schedule = -1 +s = s // ", schedule=" // str(t%schedule) +! integer(int64), allocatable :: digest_cached +if (allocated(t%digest_cached)) then + s = s // ", digest_cached=" // str(t%digest_cached) +else + s = s // ", digest_cached=()" +end if +!end type build_target_t +s = s // ")" +end function + +function info_srcfile(source) result(s) +type(srcfile_t), intent(in) :: source +character(:), allocatable :: s +integer :: i +!type srcfile_t +s = "srcfile_t(" +! character(:), allocatable :: file_name +s = s // 'file_name="' // source%file_name // '"' +! character(:), allocatable :: exe_name +s = s // ', exe_name="' // source%exe_name // '"' +! integer :: unit_scope = FPM_SCOPE_UNKNOWN +s = s // ", unit_scope=" // str(source%unit_scope) +! type(string_t), allocatable :: modules_provided(:) +s = s // ", modules_provided=[" +do i = 1, size(source%modules_provided) + s = s // '"' // source%modules_provided(i)%s // '"' + if (i < size(source%modules_provided)) s = s // ", " +end do +s = s // "]" +! integer :: unit_type = FPM_UNIT_UNKNOWN +s = s // ", unit_type=" // str(source%unit_type) +! type(string_t), allocatable :: modules_used(:) +s = s // ", modules_used=[" +do i = 1, size(source%modules_used) + s = s // '"' // source%modules_used(i)%s // '"' + if (i < size(source%modules_used)) s = s // ", " +end do +s = s // "]" +! type(string_t), allocatable :: include_dependencies(:) +s = s // ", include_dependencies=[" +do i = 1, size(source%include_dependencies) + s = s // '"' // source%include_dependencies(i)%s // '"' + if (i < size(source%include_dependencies)) s = s // ", " +end do +s = s // "]" +! type(string_t), allocatable :: link_libraries(:) +s = s // ", link_libraries=[" +do i = 1, size(source%link_libraries) + s = s // '"' // source%link_libraries(i)%s // '"' + if (i < size(source%link_libraries)) s = s // ", " +end do +s = s // "]" +! integer(int64) :: digest +s = s // ", digest=" // str(source%digest) +!end type srcfile_t +s = s // ")" +end function + +function info_model(model) result(s) +type(fpm_model_t), intent(in) :: model +character(:), allocatable :: s +integer :: i +!type :: fpm_model_t +s = "fpm_model_t(" +! character(:), allocatable :: package_name +s = s // 'package_name="' // model%package_name // '"' +! type(srcfile_t), allocatable :: sources(:) +s = s // ", sources=[" +do i = 1, size(model%sources) + s = s // info_srcfile(model%sources(i)) + if (i < size(model%sources)) s = s // ", " +end do +s = s // "]" +! type(build_target_ptr), allocatable :: targets(:) +s = s // ", targets=[" +do i = 1, size(model%targets) + s = s // info_build_target(model%targets(i)%ptr) + if (i < size(model%targets)) s = s // ", " +end do +s = s // "]" +! character(:), allocatable :: fortran_compiler +s = s // ', fortran_compiler="' // model%fortran_compiler // '"' +! character(:), allocatable :: fortran_compile_flags +s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' +! character(:), allocatable :: link_flags +s = s // ', link_flags="' // model%link_flags // '"' +! character(:), allocatable :: library_file +s = s // ', library_file="' // model%library_file // '"' +! character(:), allocatable :: output_directory +s = s // ', output_directory="' // model%output_directory // '"' +! type(string_t), allocatable :: link_libraries(:) +s = s // ", link_libraries=[" +do i = 1, size(model%link_libraries) + s = s // '"' // model%link_libraries(i)%s // '"' + if (i < size(model%link_libraries)) s = s // ", " +end do +s = s // "]" +! type(dependency_tree_t) :: deps +! TODO: print `dependency_tree_t` properly, which should become part of the +! model, not imported from another file +s = s // ", deps=dependency_tree_t(...)" +!end type fpm_model_t +s = s // ")" +end function + +subroutine show_model(model) +! Prints a human readable representation of the Model +type(fpm_model_t), intent(in) :: model +print *, info_model(model) +end subroutine + end module fpm_model -- cgit v1.2.3 From 8faaa90082ea17c0ea4a774ed0eb58adb8cf44c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 09:53:01 -0700 Subject: Print unit_scope as a string instead of a number --- fpm/src/fpm_model.f90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 72c0b04..2963b97 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -272,7 +272,23 @@ s = s // 'file_name="' // source%file_name // '"' ! character(:), allocatable :: exe_name s = s // ', exe_name="' // source%exe_name // '"' ! integer :: unit_scope = FPM_SCOPE_UNKNOWN -s = s // ", unit_scope=" // str(source%unit_scope) +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 ! type(string_t), allocatable :: modules_provided(:) s = s // ", modules_provided=[" do i = 1, size(source%modules_provided) -- cgit v1.2.3 From 39818aa5c174a3cc5d8ee2327c10162ab440ce96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 09:55:15 -0700 Subject: Print target_type as a string --- fpm/src/fpm_model.f90 | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 2963b97..3ad6dff 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -224,7 +224,19 @@ if (allocated(t%dependencies)) then end if s = s // "]" ! integer :: target_type = FPM_TARGET_UNKNOWN -s = s // ", target_type=" // str(t%target_type) +s = s // ", target_type=" +select case(t%target_type) +case (FPM_TARGET_UNKNOWN) + s = s // "FPM_TARGET_UNKNOWN" +case (FPM_TARGET_EXECUTABLE) + s = s // "FPM_TARGET_EXECUTABLE" +case (FPM_TARGET_ARCHIVE) + s = s // "FPM_TARGET_ARCHIVE" +case (FPM_TARGET_OBJECT) + s = s // "FPM_TARGET_OBJECT" +case default + s = s // "INVALID" +end select ! type(string_t), allocatable :: link_libraries(:) s = s // ", link_libraries=[" if (allocated(t%link_libraries)) then -- cgit v1.2.3 From d64229bf66a3a854d8bacccd27f01104911e141f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 09:58:36 -0700 Subject: Print unit_type as a string --- fpm/src/fpm_model.f90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 3ad6dff..e2f2ffe 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -309,7 +309,25 @@ do i = 1, size(source%modules_provided) end do s = s // "]" ! integer :: unit_type = FPM_UNIT_UNKNOWN -s = s // ", unit_type=" // str(source%unit_type) +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_CHEADER) + s = s // "FPM_UNIT_CHEADER" +case default + s = s // "INVALID" +end select ! type(string_t), allocatable :: modules_used(:) s = s // ", modules_used=[" do i = 1, size(source%modules_used) -- cgit v1.2.3 From a8ca0103647175401bdb16e2729a60b0dc9ccdd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 09:59:45 -0700 Subject: Remove str() implementation for real It is not needed at the moment, but it will have to be put back in once we extract str() into a dedicated string manipulation library (or stdlib). --- fpm/src/fpm_strings.f90 | 32 +------------------------------- 1 file changed, 1 insertion(+), 31 deletions(-) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index ad0a843..5b6104c 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -7,8 +7,6 @@ public :: f_string, lower, split, str_ends_with, string_t public :: string_array_contains, string_cat, operator(.in.), fnv_1a public :: resize, str -integer, parameter :: dp = selected_real_kind(15) - type string_t character(len=:), allocatable :: s end type @@ -32,7 +30,7 @@ interface str_ends_with end interface str_ends_with interface str - module procedure str_int, str_int64, str_real, str_real_n, str_logical + module procedure str_int, str_int64, str_logical end interface contains @@ -391,34 +389,6 @@ character(len=str_int64_len(i)) :: s write(s, '(i0)') i end function -pure integer function str_real_len(r, fmt) result(sz) -! Returns the length of the string representation of 'i' -real(dp), intent(in) :: r -character(len=*), intent(in) :: fmt -integer, parameter :: MAX_STR = 100 -character(MAX_STR) :: s -! If 's' is too short (MAX_STR too small), Fortan will abort with: -! "Fortran runtime error: End of record" -write(s, fmt) r -sz = len_trim(s) -end function - -pure function str_real(r) result(s) -! Converts the real number "r" to string with 7 decimal digits. -real(dp), intent(in) :: r -character(len=*), parameter :: fmt="(f0.6)" -character(len=str_real_len(r, fmt)) :: s -write(s, fmt) r -end function - -pure function str_real_n(r, n) result(s) -! Converts the real number "r" to string with 'n' decimal digits. -real(dp), intent(in) :: r -integer, intent(in) :: n -character(len=str_real_len(r, "(f0." // str_int(n) // ")")) :: s -write(s, "(f0." // str_int(n) // ")") r -end function - pure integer function str_logical_len(l) result(sz) ! Returns the length of the string representation of 'l' logical, intent(in) :: l -- cgit v1.2.3 From ba8ec522fcd776a18c053cafe4415c2de60bfd63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 10:02:01 -0700 Subject: Indent subroutine bodies --- fpm/src/fpm_model.f90 | 398 +++++++++++++++++++++++++------------------------- 1 file changed, 199 insertions(+), 199 deletions(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index e2f2ffe..f31735d 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -198,214 +198,214 @@ end type fpm_model_t contains recursive function info_build_target(t) result(s) -type(build_target_t), intent(in) :: t -character(:), allocatable :: s -integer :: i -!type build_target_t -s = "build_target_t(" -! character(:), allocatable :: output_file -s = s // 'output_file="' // t%output_file // '"' -! type(srcfile_t), allocatable :: source -if (allocated(t%source)) then - s = s // ", source=" // info_srcfile(t%source) -else - s = s // ", source=()" -end if -! type(build_target_ptr), allocatable :: dependencies(:) -s = s // ", dependencies=[" -if (allocated(t%dependencies)) then - do i = 1, size(t%dependencies) - ! TODO: This compiles, but it hangs at runtime due to infinite - ! recursion, so for now we just print "..." - !s = s // info_build_target(t%dependencies(i)%ptr) - s = s // "build_target_t(...)" - if (i < size(t%dependencies)) s = s // ", " - end do -end if -s = s // "]" -! integer :: target_type = FPM_TARGET_UNKNOWN -s = s // ", target_type=" -select case(t%target_type) -case (FPM_TARGET_UNKNOWN) - s = s // "FPM_TARGET_UNKNOWN" -case (FPM_TARGET_EXECUTABLE) - s = s // "FPM_TARGET_EXECUTABLE" -case (FPM_TARGET_ARCHIVE) - s = s // "FPM_TARGET_ARCHIVE" -case (FPM_TARGET_OBJECT) - s = s // "FPM_TARGET_OBJECT" -case default - s = s // "INVALID" -end select -! type(string_t), allocatable :: link_libraries(:) -s = s // ", link_libraries=[" -if (allocated(t%link_libraries)) then - do i = 1, size(t%link_libraries) - s = s // '"' // t%link_libraries(i)%s // '"' - if (i < size(t%link_libraries)) s = s // ", " - end do -end if -s = s // "]" -! type(string_t), allocatable :: link_objects(:) -s = s // ", link_objects=[" -if (allocated(t%link_objects)) then - do i = 1, size(t%link_objects) - s = s // '"' // t%link_objects(i)%s // '"' - if (i < size(t%link_objects)) s = s // ", " - end do -end if -s = s // "]" -! logical :: touched = .false. -s = s // ", touched=" // str(t%touched) -! logical :: sorted = .false. -s = s // ", sorted=" // str(t%sorted) -! logical :: skip = .false. -s = s // ", skip=" // str(t%skip) -! integer :: schedule = -1 -s = s // ", schedule=" // str(t%schedule) -! integer(int64), allocatable :: digest_cached -if (allocated(t%digest_cached)) then - s = s // ", digest_cached=" // str(t%digest_cached) -else - s = s // ", digest_cached=()" -end if -!end type build_target_t -s = s // ")" + type(build_target_t), intent(in) :: t + character(:), allocatable :: s + integer :: i + !type build_target_t + s = "build_target_t(" + ! character(:), allocatable :: output_file + s = s // 'output_file="' // t%output_file // '"' + ! type(srcfile_t), allocatable :: source + if (allocated(t%source)) then + s = s // ", source=" // info_srcfile(t%source) + else + s = s // ", source=()" + end if + ! type(build_target_ptr), allocatable :: dependencies(:) + s = s // ", dependencies=[" + if (allocated(t%dependencies)) then + do i = 1, size(t%dependencies) + ! TODO: This compiles, but it hangs at runtime due to infinite + ! recursion, so for now we just print "..." + !s = s // info_build_target(t%dependencies(i)%ptr) + s = s // "build_target_t(...)" + if (i < size(t%dependencies)) s = s // ", " + end do + end if + s = s // "]" + ! integer :: target_type = FPM_TARGET_UNKNOWN + s = s // ", target_type=" + select case(t%target_type) + case (FPM_TARGET_UNKNOWN) + s = s // "FPM_TARGET_UNKNOWN" + case (FPM_TARGET_EXECUTABLE) + s = s // "FPM_TARGET_EXECUTABLE" + case (FPM_TARGET_ARCHIVE) + s = s // "FPM_TARGET_ARCHIVE" + case (FPM_TARGET_OBJECT) + s = s // "FPM_TARGET_OBJECT" + case default + s = s // "INVALID" + end select + ! type(string_t), allocatable :: link_libraries(:) + s = s // ", link_libraries=[" + if (allocated(t%link_libraries)) then + do i = 1, size(t%link_libraries) + s = s // '"' // t%link_libraries(i)%s // '"' + if (i < size(t%link_libraries)) s = s // ", " + end do + end if + s = s // "]" + ! type(string_t), allocatable :: link_objects(:) + s = s // ", link_objects=[" + if (allocated(t%link_objects)) then + do i = 1, size(t%link_objects) + s = s // '"' // t%link_objects(i)%s // '"' + if (i < size(t%link_objects)) s = s // ", " + end do + end if + s = s // "]" + ! logical :: touched = .false. + s = s // ", touched=" // str(t%touched) + ! logical :: sorted = .false. + s = s // ", sorted=" // str(t%sorted) + ! logical :: skip = .false. + s = s // ", skip=" // str(t%skip) + ! integer :: schedule = -1 + s = s // ", schedule=" // str(t%schedule) + ! integer(int64), allocatable :: digest_cached + if (allocated(t%digest_cached)) then + s = s // ", digest_cached=" // str(t%digest_cached) + else + s = s // ", digest_cached=()" + end if + !end type build_target_t + s = s // ")" end function function info_srcfile(source) result(s) -type(srcfile_t), intent(in) :: source -character(:), allocatable :: s -integer :: i -!type srcfile_t -s = "srcfile_t(" -! character(:), allocatable :: file_name -s = s // 'file_name="' // source%file_name // '"' -! 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 -! type(string_t), allocatable :: modules_provided(:) -s = s // ", modules_provided=[" -do i = 1, size(source%modules_provided) - s = s // '"' // source%modules_provided(i)%s // '"' - if (i < size(source%modules_provided)) s = 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_CHEADER) - s = s // "FPM_UNIT_CHEADER" -case default - s = s // "INVALID" -end select -! type(string_t), allocatable :: modules_used(:) -s = s // ", modules_used=[" -do i = 1, size(source%modules_used) - s = s // '"' // source%modules_used(i)%s // '"' - if (i < size(source%modules_used)) s = s // ", " -end do -s = s // "]" -! type(string_t), allocatable :: include_dependencies(:) -s = s // ", include_dependencies=[" -do i = 1, size(source%include_dependencies) - s = s // '"' // source%include_dependencies(i)%s // '"' - if (i < size(source%include_dependencies)) s = s // ", " -end do -s = s // "]" -! type(string_t), allocatable :: link_libraries(:) -s = s // ", link_libraries=[" -do i = 1, size(source%link_libraries) - s = s // '"' // source%link_libraries(i)%s // '"' - if (i < size(source%link_libraries)) s = s // ", " -end do -s = s // "]" -! integer(int64) :: digest -s = s // ", digest=" // str(source%digest) -!end type srcfile_t -s = s // ")" + type(srcfile_t), intent(in) :: source + character(:), allocatable :: s + integer :: i + !type srcfile_t + s = "srcfile_t(" + ! character(:), allocatable :: file_name + s = s // 'file_name="' // source%file_name // '"' + ! 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 + ! type(string_t), allocatable :: modules_provided(:) + s = s // ", modules_provided=[" + do i = 1, size(source%modules_provided) + s = s // '"' // source%modules_provided(i)%s // '"' + if (i < size(source%modules_provided)) s = 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_CHEADER) + s = s // "FPM_UNIT_CHEADER" + case default + s = s // "INVALID" + end select + ! type(string_t), allocatable :: modules_used(:) + s = s // ", modules_used=[" + do i = 1, size(source%modules_used) + s = s // '"' // source%modules_used(i)%s // '"' + if (i < size(source%modules_used)) s = s // ", " + end do + s = s // "]" + ! type(string_t), allocatable :: include_dependencies(:) + s = s // ", include_dependencies=[" + do i = 1, size(source%include_dependencies) + s = s // '"' // source%include_dependencies(i)%s // '"' + if (i < size(source%include_dependencies)) s = s // ", " + end do + s = s // "]" + ! type(string_t), allocatable :: link_libraries(:) + s = s // ", link_libraries=[" + do i = 1, size(source%link_libraries) + s = s // '"' // source%link_libraries(i)%s // '"' + if (i < size(source%link_libraries)) s = s // ", " + end do + s = s // "]" + ! integer(int64) :: digest + s = s // ", digest=" // str(source%digest) + !end type srcfile_t + s = s // ")" end function function info_model(model) result(s) -type(fpm_model_t), intent(in) :: model -character(:), allocatable :: s -integer :: i -!type :: fpm_model_t -s = "fpm_model_t(" -! character(:), allocatable :: package_name -s = s // 'package_name="' // model%package_name // '"' -! type(srcfile_t), allocatable :: sources(:) -s = s // ", sources=[" -do i = 1, size(model%sources) - s = s // info_srcfile(model%sources(i)) - if (i < size(model%sources)) s = s // ", " -end do -s = s // "]" -! type(build_target_ptr), allocatable :: targets(:) -s = s // ", targets=[" -do i = 1, size(model%targets) - s = s // info_build_target(model%targets(i)%ptr) - if (i < size(model%targets)) s = s // ", " -end do -s = s // "]" -! character(:), allocatable :: fortran_compiler -s = s // ', fortran_compiler="' // model%fortran_compiler // '"' -! character(:), allocatable :: fortran_compile_flags -s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' -! character(:), allocatable :: link_flags -s = s // ', link_flags="' // model%link_flags // '"' -! character(:), allocatable :: library_file -s = s // ', library_file="' // model%library_file // '"' -! character(:), allocatable :: output_directory -s = s // ', output_directory="' // model%output_directory // '"' -! type(string_t), allocatable :: link_libraries(:) -s = s // ", link_libraries=[" -do i = 1, size(model%link_libraries) - s = s // '"' // model%link_libraries(i)%s // '"' - if (i < size(model%link_libraries)) s = s // ", " -end do -s = s // "]" -! type(dependency_tree_t) :: deps -! TODO: print `dependency_tree_t` properly, which should become part of the -! model, not imported from another file -s = s // ", deps=dependency_tree_t(...)" -!end type fpm_model_t -s = s // ")" + type(fpm_model_t), intent(in) :: model + character(:), allocatable :: s + integer :: i + !type :: fpm_model_t + s = "fpm_model_t(" + ! character(:), allocatable :: package_name + s = s // 'package_name="' // model%package_name // '"' + ! type(srcfile_t), allocatable :: sources(:) + s = s // ", sources=[" + do i = 1, size(model%sources) + s = s // info_srcfile(model%sources(i)) + if (i < size(model%sources)) s = s // ", " + end do + s = s // "]" + ! type(build_target_ptr), allocatable :: targets(:) + s = s // ", targets=[" + do i = 1, size(model%targets) + s = s // info_build_target(model%targets(i)%ptr) + if (i < size(model%targets)) s = s // ", " + end do + s = s // "]" + ! character(:), allocatable :: fortran_compiler + s = s // ', fortran_compiler="' // model%fortran_compiler // '"' + ! character(:), allocatable :: fortran_compile_flags + s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' + ! character(:), allocatable :: link_flags + s = s // ', link_flags="' // model%link_flags // '"' + ! character(:), allocatable :: library_file + s = s // ', library_file="' // model%library_file // '"' + ! character(:), allocatable :: output_directory + s = s // ', output_directory="' // model%output_directory // '"' + ! type(string_t), allocatable :: link_libraries(:) + s = s // ", link_libraries=[" + do i = 1, size(model%link_libraries) + s = s // '"' // model%link_libraries(i)%s // '"' + if (i < size(model%link_libraries)) s = s // ", " + end do + s = s // "]" + ! type(dependency_tree_t) :: deps + ! TODO: print `dependency_tree_t` properly, which should become part of the + ! model, not imported from another file + s = s // ", deps=dependency_tree_t(...)" + !end type fpm_model_t + s = s // ")" end function subroutine show_model(model) -! Prints a human readable representation of the Model -type(fpm_model_t), intent(in) :: model -print *, info_model(model) + ! Prints a human readable representation of the Model + type(fpm_model_t), intent(in) :: model + print *, info_model(model) end subroutine end module fpm_model -- cgit v1.2.3 From d34e902969fe38f777d78df545e1a8c6603e99e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 10:04:58 -0700 Subject: Implement info_srcfile_short() --- fpm/src/fpm_model.f90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index f31735d..1d72e82 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -207,7 +207,7 @@ recursive function info_build_target(t) result(s) s = s // 'output_file="' // t%output_file // '"' ! type(srcfile_t), allocatable :: source if (allocated(t%source)) then - s = s // ", source=" // info_srcfile(t%source) + s = s // ", source=" // info_srcfile_short(t%source) else s = s // ", source=()" end if @@ -355,6 +355,16 @@ function info_srcfile(source) result(s) s = s // ")" end function +function info_srcfile_short(source) result(s) + ! Prints a shortened version of srcfile_t + type(srcfile_t), intent(in) :: source + character(:), allocatable :: s + integer :: i + s = "srcfile_t(" + s = s // 'file_name="' // source%file_name // '"' + s = s // ", ...)" +end function + function info_model(model) result(s) type(fpm_model_t), intent(in) :: model character(:), allocatable :: s -- cgit v1.2.3 From e055929a52a47905dd3f04794dfd6f427d6787d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 23 Dec 2020 10:08:05 -0700 Subject: Implement info_build_target_short() --- fpm/src/fpm_model.f90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 1d72e82..d1ac015 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -197,7 +197,7 @@ end type fpm_model_t contains -recursive function info_build_target(t) result(s) +function info_build_target(t) result(s) type(build_target_t), intent(in) :: t character(:), allocatable :: s integer :: i @@ -215,10 +215,7 @@ recursive function info_build_target(t) result(s) s = s // ", dependencies=[" if (allocated(t%dependencies)) then do i = 1, size(t%dependencies) - ! TODO: This compiles, but it hangs at runtime due to infinite - ! recursion, so for now we just print "..." - !s = s // info_build_target(t%dependencies(i)%ptr) - s = s // "build_target_t(...)" + s = s // info_build_target_short(t%dependencies(i)%ptr) if (i < size(t%dependencies)) s = s // ", " end do end if @@ -273,6 +270,16 @@ recursive function info_build_target(t) result(s) s = s // ")" end function +function info_build_target_short(t) result(s) + ! Prints a shortened representation of build_target_t + type(build_target_t), intent(in) :: t + character(:), allocatable :: s + integer :: i + s = "build_target_t(" + s = s // 'output_file="' // t%output_file // '"' + s = s // ", ...)" +end function + function info_srcfile(source) result(s) type(srcfile_t), intent(in) :: source character(:), allocatable :: s -- cgit v1.2.3