Skip to content

Commit 0a86ff3

Browse files
certikcertik
authored
Merge pull request #291 from certik/show_model
Initial implementation of `fpm build --show-model`
2 parents 5ab3daf + e055929 commit 0a86ff3

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

@@ -199,6 +199,8 @@ subroutine cmd_build(settings)
199199
do i=1,size(model%targets)
200200
write(stderr,*) model%targets(i)%ptr%output_file
201201
enddo
202+
else if (settings%show_model) then
203+
call show_model(model)
202204
else
203205
call build_package(model)
204206
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, &
@@ -194,4 +195,234 @@ module fpm_model
194195

195196
end type fpm_model_t
196197

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