[flang-commits] [flang] f4a9f4b - [flang] Foil attempts to use C_PTR/C_FUNPTR as structure constructors
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 8 11:56:38 PDT 2023
Author: Peter Klausler
Date: 2023-08-08T11:51:49-07:00
New Revision: f4a9f4b613e22a3c865e7510103287f8e65440b6
URL: https://github.com/llvm/llvm-project/commit/f4a9f4b613e22a3c865e7510103287f8e65440b6
DIFF: https://github.com/llvm/llvm-project/commit/f4a9f4b613e22a3c865e7510103287f8e65440b6.diff
LOG: [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
Added:
Modified:
flang/module/__fortran_builtins.f90
flang/module/iso_c_binding.f90
flang/test/Semantics/c_loc01.f90
Removed:
################################################################################
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 0b0cec05464bb4..37907c84b2b72e 100644
--- 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
index a839d949c97ce8..9dd6c10f61080a 100644
--- 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
index 02f32e3801d91f..21fd1eb14e6df2 100644
--- 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
More information about the flang-commits
mailing list