@@ -30,9 +30,10 @@ subroutine collect_source_parsing(testsuite)
30
30
& new_unittest(" module" , test_module), &
31
31
& new_unittest(" module-with-subprogram" , test_module_with_subprogram), &
32
32
& 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), &
34
34
& new_unittest(" module-end-stmt" , test_module_end_stmt), &
35
35
& new_unittest(" program-with-module" , test_program_with_module), &
36
+ & new_unittest(" program-with-abstract-interface" , test_program_with_abstract_interface), &
36
37
& new_unittest(" submodule" , test_submodule), &
37
38
& new_unittest(" submodule-ancestor" , test_submodule_ancestor), &
38
39
& new_unittest(" subprogram" , test_subprogram), &
@@ -633,7 +634,7 @@ subroutine test_module_with_c_api(error)
633
634
634
635
end subroutine test_module_with_c_api
635
636
636
- ! > Check parsing of module exporting an abstract interface
637
+ ! > Check parsing of module exporting an abstract interface
637
638
! > See also https://github.com/fortran-lang/fpm/issues/1073
638
639
subroutine test_module_with_abstract_interface (error )
639
640
type (error_t), allocatable , intent (out ) :: error
@@ -729,6 +730,64 @@ subroutine test_program_with_module(error)
729
730
730
731
end subroutine test_program_with_module
731
732
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
732
791
733
792
! > Try to parse fortran submodule for ancestry
734
793
subroutine test_submodule (error )
0 commit comments