Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Expand parsing to include abstract interfaces #1074

Merged
merged 3 commits into from
Oct 21, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/fpm_source_parsing.f90
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,8 @@ function parse_f_source(f_filename,error) result(f_source)
end if

! Detect beginning of interface block
if (index(file_lines_lower(i)%s,'interface') == 1) then
if (index(file_lines_lower(i)%s,'interface') == 1 &
.or. parse_sequence(file_lines_lower(i)%s,'abstract','interface')) then

inside_interface = .true.
cycle
Expand Down
91 changes: 91 additions & 0 deletions test/fpm_test/test_source_parsing.f90
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +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-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 @@ -632,6 +634,37 @@ subroutine test_module_with_c_api(error)

end subroutine test_module_with_c_api

!> 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

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

allocate(temp_file,source=get_temp_filename())
open(file=temp_file,newunit=unit)
write(unit, '(A)') &
& 'module foo', &
& 'abstract interface', &
& ' subroutine bar1()', &
& ' end subroutine', &
& ' subroutine bar2() bind(c)', &
& ' end subroutine', &
& 'end interface', &
& 'end module foo'
close(unit)

f_source = parse_f_source(temp_file,error)
if (allocated(error)) return
if (f_source%unit_type /= FPM_UNIT_MODULE) then
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_MODULE')
return
end if
call f_source%test_serialization('srcfile_t: serialization', error)
end subroutine test_module_with_abstract_interface


!> Try to parse combined fortran module and program
!> Check that parsed unit type is FPM_UNIT_PROGRAM
Expand Down Expand Up @@ -697,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
Loading