Merge branch 'upstream_master' into refactor-model-sources

4 files changed, 308 insertions, 10 deletions

diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index aa86787..7609ee0 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
 
 
@@ -198,6 +198,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 fba1983..f795c56 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, &
@@ -206,4 +207,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