diff options
| -rw-r--r-- | fpm/src/fpm.f90 | 4 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 16 | ||||
| -rw-r--r-- | fpm/src/fpm_model.f90 | 235 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 63 |
4 files changed, 308 insertions, 10 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..d1ac015 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,234 @@ type :: fpm_model_t end type fpm_model_t +contains + +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_short(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) + s = s // info_build_target_short(t%dependencies(i)%ptr) + 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_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 + 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_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 + 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 diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 8e57d5b..5b6104c 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -5,7 +5,7 @@ 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 type string_t character(len=:), allocatable :: s @@ -29,6 +29,10 @@ interface str_ends_with procedure :: str_ends_with_any end interface str_ends_with +interface str + module procedure str_int, str_int64, str_logical +end interface + contains pure logical function str_ends_with_str(s, e) result(r) @@ -349,4 +353,61 @@ 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_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 |