From 4bd3c815ef1c6c246e71d4bab6996b400039ef08 Mon Sep 17 00:00:00 2001 From: Ivan Pribec Date: Sun, 22 Sep 2024 23:49:37 +0200 Subject: [PATCH 1/3] Add test for issue #1073 --- test/fpm_test/test_source_parsing.f90 | 32 +++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index c407d0c857..a663d4196e 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -30,6 +30,7 @@ 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("submodule", test_submodule), & @@ -632,6 +633,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 From f6017b2b45a3e58c073d6347118082e0751e8e2c Mon Sep 17 00:00:00 2001 From: Ivan Pribec Date: Sun, 22 Sep 2024 23:53:06 +0200 Subject: [PATCH 2/3] Add fix for missing abstract interface parsing --- src/fpm_source_parsing.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 59f8fd4d33..c1f4bab98f 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -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 From 6722dab3fffeef5461ecc0815816104c88bd916b Mon Sep 17 00:00:00 2001 From: Ivan Pribec Date: Mon, 23 Sep 2024 00:35:22 +0200 Subject: [PATCH 3/3] Add test for interface within program unit --- test/fpm_test/test_source_parsing.f90 | 63 ++++++++++++++++++++++++++- 1 file changed, 61 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index a663d4196e..616f4ffe64 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -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), & @@ -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 @@ -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)