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

[klausler]

Summary

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.

flang/module/__fortran_builtins.f90

module __Fortran_builtins
   intrinsic :: __builtin_c_f_pointer
   intrinsic :: sizeof ! extension
 
   intrinsic :: selected_int_kind
   private :: selected_int_kind
   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)
   integer, parameter :: __builtin_atomic_logical_kind = __builtin_atomic_int_kind
 
   procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
 
   type :: __builtin_dim3
module __Fortran_builtins
 
   interface operator(==)
     module procedure __builtin_c_ptr_eq
   end interface
   interface operator(/=)
     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)
     type(__builtin_c_ptr), intent(in) :: x, y
     __builtin_c_ptr_eq = x%__address == y%__address
   end function
 
   elemental logical function __builtin_c_ptr_ne(x, y)
     type(__builtin_c_ptr), intent(in) :: x, y
     __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

flang/module/iso_c_binding.f90

 !===-- module/iso_c_binding.f90 --------------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! See Fortran 2018, clause 18.2
 
 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 :: &
     c_int8_t = 1, &
     c_int16_t = 2, &
     c_int32_t = 4, &
     c_int64_t = 8, &
     c_int128_t = 16 ! anticipating future addition
#endif
   character(kind=c_char, len=1), parameter :: c_alert = achar(7)
   character(kind=c_char, len=1), parameter :: c_backspace = achar(8)
   character(kind=c_char, len=1), parameter :: c_form_feed = achar(12)
   character(kind=c_char, len=1), parameter :: c_new_line = achar(10)
   character(kind=c_char, len=1), parameter :: c_carriage_return = achar(13)
   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
 
   ! gfortran extensions
   integer, parameter :: &
     c_float128 = 16, &
     c_float128_complex = c_float128
 
  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
     ! TODO: implement
   end subroutine c_f_procpointer
 
 end module iso_c_binding

flang/test/Semantics/c_loc01.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 module m
   use iso_c_binding
   type haslen(L)
     integer, len :: L
   end type
  contains
   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)
     type(hasLen(1)), target :: clen
     type(hasLen(*)), target :: nclen
     character(2), target :: ch
     !ERROR: C_LOC() argument must be a data pointer or target
     cp = c_loc(notATarget)
     !ERROR: C_LOC() argument must be a data pointer or target
     cp = c_loc(pptr)
     !ERROR: C_LOC() argument must be contiguous
     cp = c_loc(arr(1:3:2))
     !ERROR: C_LOC() argument may not be a zero-sized array
     cp = c_loc(arr(3:1))
     !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
     cp = c_loc(poly)
     cp = c_loc(clen) ! ok
     !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
     cp = c_loc(nclen)
     !ERROR: C_LOC() argument may not be zero-length character
     cp = c_loc(ch(2:1))
     !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