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 | 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 |