Skip to content

Commit 1699b71

Browse files
LKedwardLKedward
committed
Merge branch 'upstream_master' into refactor-model-sources
2 parents d2e10f2 + 0a86ff3 commit 1699b71

File tree

4 files changed

+308
-10
lines changed

4 files changed

+308
-10
lines changed

‎fpm/src/fpm.f90

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ module fpm
99
use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, &
1010
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
1111
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, &
12-
FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE
12+
FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, show_model
1313
use fpm_compiler, only: add_compile_flag_defaults
1414

1515

@@ -198,6 +198,8 @@ subroutine cmd_build(settings)
198198
do i=1,size(model%targets)
199199
write(stderr,*) model%targets(i)%ptr%output_file
200200
enddo
201+
else if (settings%show_model) then
202+
call show_model(model)
201203
else
202204
call build_package(model)
203205
endif

‎fpm/src/fpm_command_line.f90

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ module fpm_command_line
5959

6060
type, extends(fpm_cmd_settings) :: fpm_build_settings
6161
logical :: list=.false.
62+
logical :: show_model=.false.
6263
character(len=:),allocatable :: compiler
6364
character(len=:),allocatable :: build_name
6465
end type
@@ -184,6 +185,7 @@ subroutine get_command_line_settings(cmd_settings)
184185
call set_args( '&
185186
& --release F &
186187
& --list F &
188+
& --show-model F &
187189
& --compiler "'//get_env('FPM_COMPILER','gfortran')//'" &
188190
& --verbose F&
189191
& --',help_build,version_text)
@@ -195,6 +197,7 @@ subroutine get_command_line_settings(cmd_settings)
195197
& build_name=val_build,&
196198
& compiler=val_compiler, &
197199
& list=lget('list'),&
200+
& show_model=lget('show-model'),&
198201
& verbose=lget('verbose') )
199202

200203
case('new')
@@ -737,14 +740,15 @@ subroutine set_help()
737740
' specified in the "fpm.toml" file. ', &
738741
' ', &
739742
'OPTIONS ', &
740-
' --release build in build/*_release instead of build/*_debug with ', &
741-
' high optimization instead of full debug options. ', &
742-
' --compiler COMPILER_NAME Specify a compiler name. The default is ', &
743+
' --release build in build/*_release instead of build/*_debug with ', &
744+
' high optimization instead of full debug options. ', &
745+
' --compiler COMPILER_NAME Specify a compiler name. The default is ', &
743746
' "gfortran" unless set by the environment ', &
744747
' variable FPM_COMPILER. ', &
745-
' --list list candidates instead of building or running them ', &
746-
' --help print this help and exit ', &
747-
' --version print program version information and exit ', &
748+
' --list list candidates instead of building or running them ', &
749+
' --show-model show the model and exit (do not build) ', &
750+
' --help print this help and exit ', &
751+
' --version print program version information and exit ', &
748752
' ', &
749753
'EXAMPLES ', &
750754
' Sample commands: ', &

‎fpm/src/fpm_model.f90

Lines changed: 233 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,12 +26,13 @@
2626
!>
2727
module fpm_model
2828
use iso_fortran_env, only: int64
29-
use fpm_strings, only: string_t
29+
use fpm_strings, only: string_t, str
3030
use fpm_dependency, only: dependency_tree_t
3131
implicit none
3232

3333
private
34-
public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr
34+
public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr, &
35+
show_model
3536

3637
public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
3738
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
@@ -206,4 +207,234 @@ module fpm_model
206207

207208
end type fpm_model_t
208209

210+
contains
211+
212+
function info_build_target(t) result(s)
213+
type(build_target_t), intent(in) :: t
214+
character(:), allocatable :: s
215+
integer :: i
216+
!type build_target_t
217+
s = "build_target_t("
218+
! character(:), allocatable :: output_file
219+
s = s // 'output_file="' // t%output_file // '"'
220+
! type(srcfile_t), allocatable :: source
221+
if (allocated(t%source)) then
222+
s = s // ", source=" // info_srcfile_short(t%source)
223+
else
224+
s = s // ", source=()"
225+
end if
226+
! type(build_target_ptr), allocatable :: dependencies(:)
227+
s = s // ", dependencies=["
228+
if (allocated(t%dependencies)) then
229+
do i = 1, size(t%dependencies)
230+
s = s // info_build_target_short(t%dependencies(i)%ptr)
231+
if (i < size(t%dependencies)) s = s // ", "
232+
end do
233+
end if
234+
s = s // "]"
235+
! integer :: target_type = FPM_TARGET_UNKNOWN
236+
s = s // ", target_type="
237+
select case(t%target_type)
238+
case (FPM_TARGET_UNKNOWN)
239+
s = s // "FPM_TARGET_UNKNOWN"
240+
case (FPM_TARGET_EXECUTABLE)
241+
s = s // "FPM_TARGET_EXECUTABLE"
242+
case (FPM_TARGET_ARCHIVE)
243+
s = s // "FPM_TARGET_ARCHIVE"
244+
case (FPM_TARGET_OBJECT)
245+
s = s // "FPM_TARGET_OBJECT"
246+
case default
247+
s = s // "INVALID"
248+
end select
249+
! type(string_t), allocatable :: link_libraries(:)
250+
s = s // ", link_libraries=["
251+
if (allocated(t%link_libraries)) then
252+
do i = 1, size(t%link_libraries)
253+
s = s // '"' // t%link_libraries(i)%s // '"'
254+
if (i < size(t%link_libraries)) s = s // ", "
255+
end do
256+
end if
257+
s = s // "]"
258+
! type(string_t), allocatable :: link_objects(:)
259+
s = s // ", link_objects=["
260+
if (allocated(t%link_objects)) then
261+
do i = 1, size(t%link_objects)
262+
s = s // '"' // t%link_objects(i)%s // '"'
263+
if (i < size(t%link_objects)) s = s // ", "
264+
end do
265+
end if
266+
s = s // "]"
267+
! logical :: touched = .false.
268+
s = s // ", touched=" // str(t%touched)
269+
! logical :: sorted = .false.
270+
s = s // ", sorted=" // str(t%sorted)
271+
! logical :: skip = .false.
272+
s = s // ", skip=" // str(t%skip)
273+
! integer :: schedule = -1
274+
s = s // ", schedule=" // str(t%schedule)
275+
! integer(int64), allocatable :: digest_cached
276+
if (allocated(t%digest_cached)) then
277+
s = s // ", digest_cached=" // str(t%digest_cached)
278+
else
279+
s = s // ", digest_cached=()"
280+
end if
281+
!end type build_target_t
282+
s = s // ")"
283+
end function
284+
285+
function info_build_target_short(t) result(s)
286+
! Prints a shortened representation of build_target_t
287+
type(build_target_t), intent(in) :: t
288+
character(:), allocatable :: s
289+
integer :: i
290+
s = "build_target_t("
291+
s = s // 'output_file="' // t%output_file // '"'
292+
s = s // ", ...)"
293+
end function
294+
295+
function info_srcfile(source) result(s)
296+
type(srcfile_t), intent(in) :: source
297+
character(:), allocatable :: s
298+
integer :: i
299+
!type srcfile_t
300+
s = "srcfile_t("
301+
! character(:), allocatable :: file_name
302+
s = s // 'file_name="' // source%file_name // '"'
303+
! character(:), allocatable :: exe_name
304+
s = s // ', exe_name="' // source%exe_name // '"'
305+
! integer :: unit_scope = FPM_SCOPE_UNKNOWN
306+
s = s // ", unit_scope="
307+
select case(source%unit_scope)
308+
case (FPM_SCOPE_UNKNOWN)
309+
s = s // "FPM_SCOPE_UNKNOWN"
310+
case (FPM_SCOPE_LIB)
311+
s = s // "FPM_SCOPE_LIB"
312+
case (FPM_SCOPE_DEP)
313+
s = s // "FPM_SCOPE_DEP"
314+
case (FPM_SCOPE_APP)
315+
s = s // "FPM_SCOPE_APP"
316+
case (FPM_SCOPE_TEST)
317+
s = s // "FPM_SCOPE_TEST"
318+
case (FPM_SCOPE_EXAMPLE)
319+
s = s // "FPM_SCOPE_EXAMPLE"
320+
case default
321+
s = s // "INVALID"
322+
end select
323+
! type(string_t), allocatable :: modules_provided(:)
324+
s = s // ", modules_provided=["
325+
do i = 1, size(source%modules_provided)
326+
s = s // '"' // source%modules_provided(i)%s // '"'
327+
if (i < size(source%modules_provided)) s = s // ", "
328+
end do
329+
s = s // "]"
330+
! integer :: unit_type = FPM_UNIT_UNKNOWN
331+
s = s // ", unit_type="
332+
select case(source%unit_type)
333+
case (FPM_UNIT_UNKNOWN)
334+
s = s // "FPM_UNIT_UNKNOWN"
335+
case (FPM_UNIT_PROGRAM)
336+
s = s // "FPM_UNIT_PROGRAM"
337+
case (FPM_UNIT_MODULE)
338+
s = s // "FPM_UNIT_MODULE"
339+
case (FPM_UNIT_SUBMODULE)
340+
s = s // "FPM_UNIT_SUBMODULE"
341+
case (FPM_UNIT_SUBPROGRAM)
342+
s = s // "FPM_UNIT_SUBPROGRAM"
343+
case (FPM_UNIT_CSOURCE)
344+
s = s // "FPM_UNIT_CSOURCE"
345+
case (FPM_UNIT_CHEADER)
346+
s = s // "FPM_UNIT_CHEADER"
347+
case default
348+
s = s // "INVALID"
349+
end select
350+
! type(string_t), allocatable :: modules_used(:)
351+
s = s // ", modules_used=["
352+
do i = 1, size(source%modules_used)
353+
s = s // '"' // source%modules_used(i)%s // '"'
354+
if (i < size(source%modules_used)) s = s // ", "
355+
end do
356+
s = s // "]"
357+
! type(string_t), allocatable :: include_dependencies(:)
358+
s = s // ", include_dependencies=["
359+
do i = 1, size(source%include_dependencies)
360+
s = s // '"' // source%include_dependencies(i)%s // '"'
361+
if (i < size(source%include_dependencies)) s = s // ", "
362+
end do
363+
s = s // "]"
364+
! type(string_t), allocatable :: link_libraries(:)
365+
s = s // ", link_libraries=["
366+
do i = 1, size(source%link_libraries)
367+
s = s // '"' // source%link_libraries(i)%s // '"'
368+
if (i < size(source%link_libraries)) s = s // ", "
369+
end do
370+
s = s // "]"
371+
! integer(int64) :: digest
372+
s = s // ", digest=" // str(source%digest)
373+
!end type srcfile_t
374+
s = s // ")"
375+
end function
376+
377+
function info_srcfile_short(source) result(s)
378+
! Prints a shortened version of srcfile_t
379+
type(srcfile_t), intent(in) :: source
380+
character(:), allocatable :: s
381+
integer :: i
382+
s = "srcfile_t("
383+
s = s // 'file_name="' // source%file_name // '"'
384+
s = s // ", ...)"
385+
end function
386+
387+
function info_model(model) result(s)
388+
type(fpm_model_t), intent(in) :: model
389+
character(:), allocatable :: s
390+
integer :: i
391+
!type :: fpm_model_t
392+
s = "fpm_model_t("
393+
! character(:), allocatable :: package_name
394+
s = s // 'package_name="' // model%package_name // '"'
395+
! type(srcfile_t), allocatable :: sources(:)
396+
s = s // ", sources=["
397+
do i = 1, size(model%sources)
398+
s = s // info_srcfile(model%sources(i))
399+
if (i < size(model%sources)) s = s // ", "
400+
end do
401+
s = s // "]"
402+
! type(build_target_ptr), allocatable :: targets(:)
403+
s = s // ", targets=["
404+
do i = 1, size(model%targets)
405+
s = s // info_build_target(model%targets(i)%ptr)
406+
if (i < size(model%targets)) s = s // ", "
407+
end do
408+
s = s // "]"
409+
! character(:), allocatable :: fortran_compiler
410+
s = s // ', fortran_compiler="' // model%fortran_compiler // '"'
411+
! character(:), allocatable :: fortran_compile_flags
412+
s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"'
413+
! character(:), allocatable :: link_flags
414+
s = s // ', link_flags="' // model%link_flags // '"'
415+
! character(:), allocatable :: library_file
416+
s = s // ', library_file="' // model%library_file // '"'
417+
! character(:), allocatable :: output_directory
418+
s = s // ', output_directory="' // model%output_directory // '"'
419+
! type(string_t), allocatable :: link_libraries(:)
420+
s = s // ", link_libraries=["
421+
do i = 1, size(model%link_libraries)
422+
s = s // '"' // model%link_libraries(i)%s // '"'
423+
if (i < size(model%link_libraries)) s = s // ", "
424+
end do
425+
s = s // "]"
426+
! type(dependency_tree_t) :: deps
427+
! TODO: print `dependency_tree_t` properly, which should become part of the
428+
! model, not imported from another file
429+
s = s // ", deps=dependency_tree_t(...)"
430+
!end type fpm_model_t
431+
s = s // ")"
432+
end function
433+
434+
subroutine show_model(model)
435+
! Prints a human readable representation of the Model
436+
type(fpm_model_t), intent(in) :: model
437+
print *, info_model(model)
438+
end subroutine
439+
209440
end module fpm_model

‎fpm/src/fpm_strings.f90

Lines changed: 62 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module fpm_strings
55
private
66
public :: f_string, lower, split, str_ends_with, string_t
77
public :: string_array_contains, string_cat, operator(.in.), fnv_1a
8-
public :: resize
8+
public :: resize, str
99

1010
type string_t
1111
character(len=:), allocatable :: s
@@ -29,6 +29,10 @@ module fpm_strings
2929
procedure :: str_ends_with_any
3030
end interface str_ends_with
3131

32+
interface str
33+
module procedure str_int, str_int64, str_logical
34+
end interface
35+
3236
contains
3337

3438
pure logical function str_ends_with_str(s, e) result(r)
@@ -349,4 +353,61 @@ subroutine resize_string(list, n)
349353

350354
end subroutine resize_string
351355

356+
pure integer function str_int_len(i) result(sz)
357+
! Returns the length of the string representation of 'i'
358+
integer, intent(in) :: i
359+
integer, parameter :: MAX_STR = 100
360+
character(MAX_STR) :: s
361+
! If 's' is too short (MAX_STR too small), Fortran will abort with:
362+
! "Fortran runtime error: End of record"
363+
write(s, '(i0)') i
364+
sz = len_trim(s)
365+
end function
366+
367+
pure function str_int(i) result(s)
368+
! Converts integer "i" to string
369+
integer, intent(in) :: i
370+
character(len=str_int_len(i)) :: s
371+
write(s, '(i0)') i
372+
end function
373+
374+
pure integer function str_int64_len(i) result(sz)
375+
! Returns the length of the string representation of 'i'
376+
integer(int64), intent(in) :: i
377+
integer, parameter :: MAX_STR = 100
378+
character(MAX_STR) :: s
379+
! If 's' is too short (MAX_STR too small), Fortran will abort with:
380+
! "Fortran runtime error: End of record"
381+
write(s, '(i0)') i
382+
sz = len_trim(s)
383+
end function
384+
385+
pure function str_int64(i) result(s)
386+
! Converts integer "i" to string
387+
integer(int64), intent(in) :: i
388+
character(len=str_int64_len(i)) :: s
389+
write(s, '(i0)') i
390+
end function
391+
392+
pure integer function str_logical_len(l) result(sz)
393+
! Returns the length of the string representation of 'l'
394+
logical, intent(in) :: l
395+
if (l) then
396+
sz = 6
397+
else
398+
sz = 7
399+
end if
400+
end function
401+
402+
pure function str_logical(l) result(s)
403+
! Converts logical "l" to string
404+
logical, intent(in) :: l
405+
character(len=str_logical_len(l)) :: s
406+
if (l) then
407+
s = ".true."
408+
else
409+
s = ".false."
410+
end if
411+
end function
412+
352413
end module fpm_strings

0 commit comments

Comments
 (0)