Skip to content

Commit 0c6c3a4

Browse files
kubajjkubajj
committed
Split traverse_oss into two functions to make all arguments not optional
1 parent 702a0e2 commit 0c6c3a4

File tree

1 file changed

+83
-41
lines changed

1 file changed

+83
-41
lines changed

‎src/fpm/manifest/profiles.f90‎

Lines changed: 83 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -353,9 +353,9 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof
353353
& flags, c_flags, link_time_flags, file_scope_flags)
354354
profindex = profindex + 1
355355
end subroutine get_flags
356-
357-
!> Traverse operating system tables
358-
subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size, profiles, profindex)
356+
357+
!> Traverse operating system tables to obtain number of profiles
358+
subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error)
359359

360360
!> Name of profile
361361
character(len=:), allocatable, intent(in) :: profile_name
@@ -373,23 +373,89 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof
373373
type(error_t), allocatable, intent(out) :: error
374374

375375
!> Number of profiles in list of profiles
376-
integer, intent(inout), optional :: profiles_size
376+
integer, intent(inout) :: profiles_size
377+
378+
type(toml_key), allocatable :: key_list(:)
379+
character(len=:), allocatable :: os_name, l_os_name
380+
type(toml_table), pointer :: os_node
381+
integer :: ios, stat
382+
logical :: is_valid, key_val_added, is_key_val
383+
384+
if (size(os_list)<1) return
385+
key_val_added = .false.
386+
do ios = 1, size(os_list)
387+
os_name = os_list(ios)%key
388+
call validate_os_name(os_name, is_valid)
389+
if (is_valid) then
390+
call get_value(table, os_name, os_node, stat=stat)
391+
if (stat /= toml_stat%success) then
392+
call syntax_error(error, "os "//os_name//" has to be a table")
393+
return
394+
end if
395+
call os_node%get_keys(key_list)
396+
profiles_size = profiles_size + 1
397+
call validate_profile_table(profile_name, compiler_name, key_list, os_node, error, .true.)
398+
else
399+
! Not lowercase OS name
400+
l_os_name = lower(os_name)
401+
call validate_os_name(l_os_name, is_valid)
402+
if (is_valid) then
403+
call fatal_error(error,'*traverse_oss*:Error: Name of the operating system must be a lowercase string.')
404+
end if
405+
if (allocated(error)) return
406+
407+
! Missing OS name
408+
is_key_val = .false.
409+
os_name = os_list(ios)%key
410+
call get_value(table, os_name, os_node, stat=stat)
411+
if (stat /= toml_stat%success) then
412+
is_key_val = .true.
413+
end if
414+
os_node=>table
415+
if (is_key_val.and..not.key_val_added) then
416+
key_val_added = .true.
417+
is_key_val = .false.
418+
profiles_size = profiles_size + 1
419+
else if (.not.is_key_val) then
420+
profiles_size = profiles_size + 1
421+
end if
422+
call validate_profile_table(profile_name, compiler_name, os_list, os_node, error, .false.)
423+
end if
424+
end do
425+
end subroutine traverse_oss_for_size
426+
427+
428+
!> Traverse operating system tables to obtain profiles
429+
subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, profindex, error)
430+
431+
!> Name of profile
432+
character(len=:), allocatable, intent(in) :: profile_name
433+
434+
!> Name of compiler
435+
character(len=:), allocatable, intent(in) :: compiler_name
436+
437+
!> List of OSs in table with profile name and compiler name given
438+
type(toml_key), allocatable, intent(in) :: os_list(:)
439+
440+
!> Table containing OS tables
441+
type(toml_table), pointer, intent(in) :: table
442+
443+
!> Error handling
444+
type(error_t), allocatable, intent(out) :: error
377445

378446
!> List of profiles
379-
type(profile_config_t), allocatable, intent(inout), optional :: profiles(:)
447+
type(profile_config_t), allocatable, intent(inout) :: profiles(:)
380448

381449
!> Index in the list of profiles
382-
integer, intent(inout), optional :: profindex
450+
integer, intent(inout) :: profindex
383451

384452
type(toml_key), allocatable :: key_list(:)
385453
character(len=:), allocatable :: os_name, l_os_name
386454
type(toml_table), pointer :: os_node
387-
character(len=:), allocatable :: flags
388455
integer :: ios, stat, os_type
389-
logical :: is_valid, key_val_added, is_key_val
456+
logical :: is_valid, is_key_val
390457

391458
if (size(os_list)<1) return
392-
key_val_added = .false.
393459
do ios = 1, size(os_list)
394460
os_name = os_list(ios)%key
395461
call validate_os_name(os_name, is_valid)
@@ -400,17 +466,8 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof
400466
return
401467
end if
402468
call os_node%get_keys(key_list)
403-
if (present(profiles_size)) then
404-
profiles_size = profiles_size + 1
405-
call validate_profile_table(profile_name, compiler_name, key_list, os_node, error, .true.)
406-
else
407-
if (.not.(present(profiles).and.present(profindex))) then
408-
call fatal_error(error, "Both profiles and profindex have to be present")
409-
return
410-
end if
411-
call match_os_type(os_name, os_type)
412-
call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, .true.)
413-
end if
469+
call match_os_type(os_name, os_type)
470+
call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, .true.)
414471
else
415472
! Not lowercase OS name
416473
l_os_name = lower(os_name)
@@ -428,23 +485,8 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof
428485
is_key_val = .true.
429486
end if
430487
os_node=>table
431-
if (present(profiles_size)) then
432-
if (is_key_val.and..not.key_val_added) then
433-
key_val_added = .true.
434-
is_key_val = .false.
435-
profiles_size = profiles_size + 1
436-
else if (.not.is_key_val) then
437-
profiles_size = profiles_size + 1
438-
end if
439-
call validate_profile_table(profile_name, compiler_name, os_list, os_node, error, .false.)
440-
else
441-
if (.not.(present(profiles).and.present(profindex))) then
442-
call fatal_error(error, "Both profiles and profindex have to be present")
443-
return
444-
end if
445-
os_type = OS_ALL
446-
call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, .false.)
447-
end if
488+
os_type = OS_ALL
489+
call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, .false.)
448490
end if
449491
end do
450492
end subroutine traverse_oss
@@ -491,15 +533,15 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si
491533
end if
492534
call comp_node%get_keys(os_list)
493535
if (present(profiles_size)) then
494-
call traverse_oss(profile_name, compiler_name, os_list, comp_node, error, profiles_size=profiles_size)
536+
call traverse_oss_for_size(profile_name, compiler_name, os_list, comp_node, profiles_size, error)
495537
if (allocated(error)) return
496538
else
497539
if (.not.(present(profiles).and.present(profindex))) then
498540
call fatal_error(error, "Both profiles and profindex have to be present")
499541
return
500542
end if
501543
call traverse_oss(profile_name, compiler_name, os_list, comp_node, &
502-
& error, profiles=profiles, profindex=profindex)
544+
& profiles, profindex, error)
503545
if (allocated(error)) return
504546
end if
505547
else
@@ -554,7 +596,7 @@ subroutine new_profiles(profiles, table, error)
554596
os_list = prof_list(iprof:iprof)
555597
profile_name = 'all'
556598
compiler_name = DEFAULT_COMPILER
557-
call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size)
599+
call traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error)
558600
if (allocated(error)) return
559601
else
560602
call get_value(table, profile_name, prof_node, stat=stat)
@@ -592,7 +634,7 @@ subroutine new_profiles(profiles, table, error)
592634
profile_name = 'all'
593635
compiler_name = DEFAULT_COMPILER
594636
prof_node=>table
595-
call traverse_oss(profile_name, compiler_name, os_list, prof_node, error, profiles=profiles, profindex=profindex)
637+
call traverse_oss(profile_name, compiler_name, os_list, prof_node, profiles, profindex, error)
596638
if (allocated(error)) return
597639
else
598640
call get_value(table, profile_name, prof_node, stat=stat)

0 commit comments

Comments
 (0)