Update: to detect exported C API in modules via bind(C)

Sources containing module subroutines and functions with bind(C) are labelled as SUBPROGRAM to disable pruning.

Author: LKedward

src/fpm_source_parsing.f90

@@ -76,7 +76,7 @@ function parse_f_source(f_filename,error) result(f_source)
     type(srcfile_t) :: f_source
     type(error_t), allocatable, intent(out) :: error
 
-    logical :: inside_module
+    logical :: inside_module, inside_interface
     integer :: stat
     integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass
     type(string_t), allocatable :: file_lines(:), file_lines_lower(:)
@@ -111,6 +111,7 @@ function parse_f_source(f_filename,error) result(f_source)
         n_mod = 0
         n_parent = 0
         inside_module = .false.
+        inside_interface = .false.
         file_loop: do i=1,size(file_lines_lower)
 
             ! Skip comment lines and preprocessor directives
@@ -120,6 +121,36 @@ function parse_f_source(f_filename,error) result(f_source)
                 cycle
             end if
 
+            ! Detect exported C-API via bind(C)
+            if (.not.inside_interface .and. &
+                index(file_lines_lower(i)%s,'bind(c') > 0) then
+                
+                do j=i,1,-1
+
+                    if (index(file_lines_lower(j)%s,'function') > 0 .or. &
+                        index(file_lines_lower(j)%s,'subroutine') > 0) then
+                        f_source%unit_type = FPM_UNIT_SUBPROGRAM
+                        exit
+                    end if
+
+                    if (j>1) then
+
+                        ic = index(file_lines_lower(j-1)%s,'!')
+                        if (ic < 1) then
+                            ic = len(file_lines_lower(j-1)%s)
+                        end if
+
+                        temp_string = trim(file_lines_lower(j-1)%s(1:ic))
+                        if (index(temp_string,'&') /= len(temp_string)) then
+                            exit
+                        end if
+
+                    end if
+
+                end do
+
+            end if
+
             ! Skip lines that are continued: not statements
             if (i > 1) then
                 ic = index(file_lines_lower(i-1)%s,'!')
@@ -132,6 +163,27 @@ function parse_f_source(f_filename,error) result(f_source)
                 end if
             end if
 
+            ! Detect beginning of interface block
+            if (index(file_lines_lower(i)%s,'interface') == 1) then
+
+                inside_interface = .true.
+                cycle
+
+            end if
+
+            ! Detect end of interface block
+            if (index(file_lines_lower(i)%s,'end') == 1 .and. &
+                len(file_lines_lower(i)%s) > 3) then
+
+                if (index(adjustl(file_lines_lower(i)%s(4:)),'interface') == 1) then
+
+                    inside_interface = .false.
+                    cycle
+
+                end if
+
+            end if
+
             ! Process 'USE' statements
             if (index(file_lines_lower(i)%s,'use ') == 1 .or. &
                 index(file_lines_lower(i)%s,'use::') == 1) then

test/fpm_test/test_source_parsing.f90

@@ -27,6 +27,7 @@ subroutine collect_source_parsing(testsuite)
             & new_unittest("program", test_program), &
             & 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-end-stmt", test_module_end_stmt), &
             & new_unittest("program-with-module", test_program_with_module), &
             & new_unittest("submodule", test_submodule), &
@@ -315,7 +316,7 @@ subroutine test_module(error)
             & 'module  my_mod ! A trailing comment', &
             & 'use module_one', &
             & 'interface', &
-            & '  module subroutine f()', &
+            & '  module subroutine f() bind(C)', &
             & 'end interface', &
             & 'integer :: program', &
             & 'program = 1', &
@@ -325,6 +326,10 @@ subroutine test_module(error)
             & 'contains', &
             & 'module subroutine&', &
             & ' e()', &
+            & ' integer, parameter :: c = 1', &
+            & ' integer :: & ', &
+            & '       bind(c)', &
+            & ' bind(c) = 1', &
             & 'end subroutine e', &
             & 'module subroutine f()', &
             & 'end subroutine f', &
@@ -489,6 +494,54 @@ subroutine test_module_end_stmt(error)
     end subroutine test_module_end_stmt
 
 
+    !> Try to parse fortran module with exported C-API via bind(c)
+    !>  (this should be detected as FPM_UNIT_SUBPROGRAM not FPM_UNIT_MODULE to prevent pruning)
+    subroutine test_module_with_c_api(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)') &
+            & 'module  my_mod', &
+            & 'contains', &
+            & 'subroutine f() &', &
+            & '           bind(C)', &
+            & 'end subroutine f', &
+            & 'module function g()', &
+            & 'end function g', &
+            & 'end module test'
+        close(unit)
+
+        f_source = parse_f_source(temp_file,error)
+        if (allocated(error)) then
+            return
+        end if
+
+        if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then
+            call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM')
+            return
+        end if
+
+        if (size(f_source%modules_provided) /= 1) then
+            call test_failed(error,'Unexpected modules_provided - expecting one')
+            return
+        end if
+
+        if (size(f_source%modules_used) /= 0) then
+            call test_failed(error,'Incorrect number of modules_used - expecting zero')
+            return
+        end if
+
+    end subroutine test_module_with_c_api
+
+
     !> Try to parse combined fortran module and program
     !>  Check that parsed unit type is FPM_UNIT_PROGRAM
     subroutine test_program_with_module(error)