Skip to content

Commit

Permalink
Add test for interface within program unit
Browse files Browse the repository at this point in the history
  • Loading branch information
ivan-pi committed Sep 22, 2024
1 parent f6017b2 commit 6722dab
Showing 1 changed file with 61 additions and 2 deletions.
63 changes: 61 additions & 2 deletions test/fpm_test/test_source_parsing.f90
Original file line number Diff line number Diff line change
Expand Up @@ -30,9 +30,10 @@ subroutine collect_source_parsing(testsuite)
& new_unittest("module", test_module), &
& new_unittest("module-with-subprogram", test_module_with_subprogram), &
& new_unittest("module-with-c-api", test_module_with_c_api), &
& new_unittest("module-with-abstract-interface",test_module_with_abstract_interface), &
& new_unittest("module-with-abstract-interface",test_module_with_abstract_interface), &
& new_unittest("module-end-stmt", test_module_end_stmt), &
& new_unittest("program-with-module", test_program_with_module), &
& new_unittest("program-with-abstract-interface", test_program_with_abstract_interface), &
& new_unittest("submodule", test_submodule), &
& new_unittest("submodule-ancestor", test_submodule_ancestor), &
& new_unittest("subprogram", test_subprogram), &
Expand Down Expand Up @@ -633,7 +634,7 @@ subroutine test_module_with_c_api(error)

end subroutine test_module_with_c_api

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

end subroutine test_program_with_module

!> Check parsing of interfaces within program unit
!> See also https://github.com/fortran-lang/fpm/issues/1073
subroutine test_program_with_abstract_interface(error)

!> Error handling
type(error_t), allocatable, intent(out) :: error

integer :: unit
character(:), allocatable :: temp_file
type(srcfile_t), allocatable :: f_source

allocate(temp_file, source=get_temp_filename())

open(file=temp_file, newunit=unit)
write(unit, '(a)') &
& 'program my_program', &
& 'implicit none', &
& 'abstract interface', &
& ' function cmpfunc(a,b) bind(c)', &
& ' use, intrinsic :: iso_c_binding', &
& ' type(c_ptr), intent(in), value :: a, b', &
& ' integer(c_int) :: cmpfunc', &
& ' end function', &
& 'end interface', &
& 'interface', &
& ' subroutine qsort(ptr,count,size,comp) bind(c,name="qsort")', &
& ' use, intrinsic :: iso_c_binding', &
& ' type(c_ptr), value :: ptr', &
& ' integer(c_size_t), value :: count, size', &
& ' type(c_funptr), value :: comp', &
& 'end interface', &
& 'end program my_program'
close(unit)

f_source = parse_f_source(temp_file,error)
if (allocated(error)) then
return
end if

if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM')
return
end if

if (size(f_source%modules_provided) /= 0) then
call test_failed(error,'Unexpected modules_provided - expecting zero')
return
end if

! Intrinsic modules are not counted in `modules_used` (!)
if (size(f_source%modules_used) /= 0) then
call test_failed(error,'Incorrect number of modules_used - expecting zero')
return
end if

call f_source%test_serialization('srcfile_t: serialization', error)

end subroutine test_program_with_abstract_interface

!> Try to parse fortran submodule for ancestry
subroutine test_submodule(error)
Expand Down

0 comments on commit 6722dab

Please sign in to comment.