[flang] Foil attempts to use C_PTR/C_FUNPTR as structure constructors

The internal details of the C_PTR and C_FUNPTR types must be made private so that user code can't try to access their components or attempt to use their structure constructors. Fixes llvm-test-suite/Fortran/fortran/c_ptr_tests_13.f90. Differential Revision: https://reviews.llvm.org/D157343
llvm · Aug 8, 2023 · f4a9f4b · f4a9f4b
1 parent 6bc14f2
commit f4a9f4b
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 46 deletions.
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
@@ -21,23 +21,23 @@
   integer, parameter, private :: int64 = selected_int_kind(18)
 
   type, bind(c) :: __builtin_c_ptr
-    integer(kind=int64) :: __address
+    integer(kind=int64), private :: __address
   end type
 
   type, bind(c) :: __builtin_c_funptr
-    integer(kind=int64) :: __address
+    integer(kind=int64), private :: __address
   end type
 
   type :: __builtin_event_type
-    integer(kind=int64) :: __count
+    integer(kind=int64), private :: __count
   end type
 
   type :: __builtin_lock_type
-    integer(kind=int64) :: __count
+    integer(kind=int64), private :: __count
   end type
 
   type :: __builtin_team_type
-    integer(kind=int64) :: __id
+    integer(kind=int64), private :: __id
   end type
 
   integer, parameter :: __builtin_atomic_int_kind = selected_int_kind(18)
@@ -83,6 +83,15 @@
     module procedure __builtin_c_ptr_eq
   end interface
 
+  interface __builtin_c_associated
+    module procedure c_associated_c_ptr
+    module procedure c_associated_c_funptr
+  end interface
+  private :: c_associated_c_ptr, c_associated_c_funptr
+
+  type(__builtin_c_ptr), parameter :: __builtin_c_null_ptr = __builtin_c_ptr(0)
+  type(__builtin_c_funptr), parameter :: __builtin_c_null_funptr = __builtin_c_funptr(0)
+
 contains
 
   elemental logical function __builtin_c_ptr_eq(x, y)
@@ -95,4 +104,34 @@
     __builtin_c_ptr_ne = x%__address /= y%__address
   end function
 
+  function __builtin_c_funloc(x)
+    type(__builtin_c_funptr) :: __builtin_c_funloc
+    external :: x
+    __builtin_c_funloc = __builtin_c_funptr(loc(x))
+  end function
+
+  pure logical function c_associated_c_ptr(c_ptr_1, c_ptr_2)
+    type(__builtin_c_ptr), intent(in) :: c_ptr_1
+    type(__builtin_c_ptr), intent(in), optional :: c_ptr_2
+    if (c_ptr_1%__address == __builtin_c_null_ptr%__address) then
+      c_associated_c_ptr = .false.
+    else if (present(c_ptr_2)) then
+      c_associated_c_ptr = c_ptr_1%__address == c_ptr_2%__address
+    else
+      c_associated_c_ptr = .true.
+    end if
+  end function c_associated_c_ptr
+
+  pure logical function c_associated_c_funptr(c_funptr_1, c_funptr_2)
+    type(__builtin_c_funptr), intent(in) :: c_funptr_1
+    type(__builtin_c_funptr), intent(in), optional :: c_funptr_2
+    if (c_funptr_1%__address == __builtin_c_null_ptr%__address) then
+      c_associated_c_funptr = .false.
+    else if (present(c_funptr_2)) then
+      c_associated_c_funptr = c_funptr_1%__address == c_funptr_2%__address
+    else
+      c_associated_c_funptr = .true.
+    end if
+  end function c_associated_c_funptr
+
 end module
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
@@ -11,16 +11,17 @@
 module iso_c_binding
 
   use __Fortran_builtins, only: &
+    c_associated => __builtin_c_associated, &
+    c_funloc => __builtin_c_funloc, &
+    c_funptr => __builtin_c_funptr, &
     c_f_pointer => __builtin_c_f_pointer, &
+    c_loc => __builtin_c_loc, &
+    c_null_funptr => __builtin_c_null_funptr, &
+    c_null_ptr => __builtin_c_null_ptr, &
     c_ptr => __builtin_c_ptr, &
-    c_funptr => __builtin_c_funptr, &
     c_sizeof => sizeof, &
-    c_loc => __builtin_c_loc, &
     operator(==), operator(/=)
 
-  type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
-  type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
-
   ! Table 18.2 (in clause 18.3.1)
   ! TODO: Specialize (via macros?) for alternative targets
   integer, parameter :: &
@@ -78,12 +79,6 @@ module iso_c_binding
   character(kind=c_char, len=1), parameter :: c_horizontal_tab = achar(9)
   character(kind=c_char, len=1), parameter :: c_vertical_tab =  achar(11)
 
-  interface c_associated
-    module procedure c_associated_c_ptr
-    module procedure c_associated_c_funptr
-  end interface
-  private :: c_associated_c_ptr, c_associated_c_funptr
-
   interface c_f_procpointer
     module procedure c_f_procpointer
   end interface
@@ -95,36 +90,6 @@ module iso_c_binding
 
  contains
 
-  pure logical function c_associated_c_ptr(c_ptr_1, c_ptr_2)
-    type(c_ptr), intent(in) :: c_ptr_1
-    type(c_ptr), intent(in), optional :: c_ptr_2
-    if (c_ptr_1%__address == c_null_ptr%__address) then
-      c_associated_c_ptr = .false.
-    else if (present(c_ptr_2)) then
-      c_associated_c_ptr = c_ptr_1%__address == c_ptr_2%__address
-    else
-      c_associated_c_ptr = .true.
-    end if
-  end function c_associated_c_ptr
-
-  pure logical function c_associated_c_funptr(c_funptr_1, c_funptr_2)
-    type(c_funptr), intent(in) :: c_funptr_1
-    type(c_funptr), intent(in), optional :: c_funptr_2
-    if (c_funptr_1%__address == c_null_ptr%__address) then
-      c_associated_c_funptr = .false.
-    else if (present(c_funptr_2)) then
-      c_associated_c_funptr = c_funptr_1%__address == c_funptr_2%__address
-    else
-      c_associated_c_funptr = .true.
-    end if
-  end function c_associated_c_funptr
-
-  function c_funloc(x)
-    type(c_funptr) :: c_funloc
-    external :: x
-    c_funloc = c_funptr(loc(x))
-  end function c_funloc
-
   subroutine c_f_procpointer(cptr, fptr)
     type(c_funptr), intent(in) :: cptr
     procedure(), pointer, intent(out) :: fptr

diff --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90
@@ -9,6 +9,7 @@ subroutine test(assumedType, poly, nclen)
     type(*), target :: assumedType
     class(*), target ::  poly
     type(c_ptr) cp
+    type(c_funptr) cfp
     real notATarget
     procedure(sin), pointer :: pptr
     real, target :: arr(3)
@@ -33,5 +34,13 @@ subroutine test(assumedType, poly, nclen)
     !WARNING: C_LOC() argument has non-interoperable intrinsic type, kind, or length
     cp = c_loc(ch)
     cp = c_loc(ch(1:1)) ! ok)
+    !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
+    cp = c_ptr(0)
+    !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
+    cfp = c_funptr(0)
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_ptr) and TYPE(c_funptr)
+    cp = cfp
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_funptr) and TYPE(c_ptr)
+    cfp = cp
   end
 end module