Skip to content

Commit 6722dab

Browse files
committed
Add test for interface within program unit
1 parent f6017b2 commit 6722dab

File tree

1 file changed

+61
-2
lines changed

1 file changed

+61
-2
lines changed

test/fpm_test/test_source_parsing.f90

Lines changed: 61 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,10 @@ subroutine collect_source_parsing(testsuite)
3030
& new_unittest("module", test_module), &
3131
& new_unittest("module-with-subprogram", test_module_with_subprogram), &
3232
& new_unittest("module-with-c-api", test_module_with_c_api), &
33-
& new_unittest("module-with-abstract-interface",test_module_with_abstract_interface), &
33+
& new_unittest("module-with-abstract-interface",test_module_with_abstract_interface), &
3434
& new_unittest("module-end-stmt", test_module_end_stmt), &
3535
& new_unittest("program-with-module", test_program_with_module), &
36+
& new_unittest("program-with-abstract-interface", test_program_with_abstract_interface), &
3637
& new_unittest("submodule", test_submodule), &
3738
& new_unittest("submodule-ancestor", test_submodule_ancestor), &
3839
& new_unittest("subprogram", test_subprogram), &
@@ -633,7 +634,7 @@ subroutine test_module_with_c_api(error)
633634

634635
end subroutine test_module_with_c_api
635636

636-
!> Check parsing of module exporting an abstract interface
637+
!> Check parsing of module exporting an abstract interface
637638
!> See also https://github.com/fortran-lang/fpm/issues/1073
638639
subroutine test_module_with_abstract_interface(error)
639640
type(error_t), allocatable, intent(out) :: error
@@ -729,6 +730,64 @@ subroutine test_program_with_module(error)
729730

730731
end subroutine test_program_with_module
731732

733+
!> Check parsing of interfaces within program unit
734+
!> See also https://github.com/fortran-lang/fpm/issues/1073
735+
subroutine test_program_with_abstract_interface(error)
736+
737+
!> Error handling
738+
type(error_t), allocatable, intent(out) :: error
739+
740+
integer :: unit
741+
character(:), allocatable :: temp_file
742+
type(srcfile_t), allocatable :: f_source
743+
744+
allocate(temp_file, source=get_temp_filename())
745+
746+
open(file=temp_file, newunit=unit)
747+
write(unit, '(a)') &
748+
& 'program my_program', &
749+
& 'implicit none', &
750+
& 'abstract interface', &
751+
& ' function cmpfunc(a,b) bind(c)', &
752+
& ' use, intrinsic :: iso_c_binding', &
753+
& ' type(c_ptr), intent(in), value :: a, b', &
754+
& ' integer(c_int) :: cmpfunc', &
755+
& ' end function', &
756+
& 'end interface', &
757+
& 'interface', &
758+
& ' subroutine qsort(ptr,count,size,comp) bind(c,name="qsort")', &
759+
& ' use, intrinsic :: iso_c_binding', &
760+
& ' type(c_ptr), value :: ptr', &
761+
& ' integer(c_size_t), value :: count, size', &
762+
& ' type(c_funptr), value :: comp', &
763+
& 'end interface', &
764+
& 'end program my_program'
765+
close(unit)
766+
767+
f_source = parse_f_source(temp_file,error)
768+
if (allocated(error)) then
769+
return
770+
end if
771+
772+
if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
773+
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM')
774+
return
775+
end if
776+
777+
if (size(f_source%modules_provided) /= 0) then
778+
call test_failed(error,'Unexpected modules_provided - expecting zero')
779+
return
780+
end if
781+
782+
! Intrinsic modules are not counted in `modules_used` (!)
783+
if (size(f_source%modules_used) /= 0) then
784+
call test_failed(error,'Incorrect number of modules_used - expecting zero')
785+
return
786+
end if
787+
788+
call f_source%test_serialization('srcfile_t: serialization', error)
789+
790+
end subroutine test_program_with_abstract_interface
732791

733792
!> Try to parse fortran submodule for ancestry
734793
subroutine test_submodule(error)

0 commit comments

Comments
 (0)