Dear all, the attached patch fixes argument checking of:
- C_SIZEOF - rejects-valid (see below) and ICE-on-valid - C_F_POINTER - ICE-on-invalid The interesting part is that C_SIZEOF was not well specified until after F2018, where an interp request lead to an edit that actually loosened restrictions and makes the checking much more straightforward, since expressions and function results are now allowed. I've added references to the relevant text and interp in the commit message. While updating the checking code shared between C_SIZEOF and C_F_POINTER, I figured that the latter missed a check preventing an ICE-on-invalid when a function returning a pointer was passed. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 6f412a6399a7e125db835584d3d2489a52150c27 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anl...@gmx.de> Date: Mon, 8 Apr 2024 21:43:24 +0200 Subject: [PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500] The interpretation of the F2018 standard regarding valid arguments to the intrinsic C_SIZEOF(X) was clarified in an edit to 18-007r1: https://j3-fortran.org/doc/year/22/22-101r1.txt loosening restrictions and giving examples. The F2023 text has: ! F2023:18.2.3.8 C_SIZEOF (X) ! ! X shall be a data entity with interoperable type and type parameters, ! and shall not be an assumed-size array, an assumed-rank array that ! is associated with an assumed-size array, an unallocated allocatable ! variable, or a pointer that is not associated. where ! 3.41 data entity ! data object, result of the evaluation of an expression, or the ! result of the execution of a function reference Update the checking code for interoperable arguments accordingly, and extend to reject functions returning pointer as FPTR argument to C_F_POINTER. gcc/fortran/ChangeLog: PR fortran/106500 * check.cc (is_c_interoperable): Fix checks for C_SIZEOF. (gfc_check_c_f_pointer): Reject function returning a pointer as FPTR. gcc/testsuite/ChangeLog: PR fortran/106500 * gfortran.dg/c_sizeof_6.f90: Remove wrong dg-error. * gfortran.dg/c_f_pointer_tests_9.f90: New test. * gfortran.dg/c_sizeof_7.f90: New test. --- gcc/fortran/check.cc | 21 ++++++---- .../gfortran.dg/c_f_pointer_tests_9.f90 | 21 ++++++++++ gcc/testsuite/gfortran.dg/c_sizeof_6.f90 | 2 +- gcc/testsuite/gfortran.dg/c_sizeof_7.f90 | 42 +++++++++++++++++++ 4 files changed, 76 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 create mode 100644 gcc/testsuite/gfortran.dg/c_sizeof_7.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index db74dcf3f40..b7f60575c67 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -5299,18 +5299,14 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) return false; } - if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY) + /* Checks for C_SIZEOF need to take into account edits to 18-007r1, see + https://j3-fortran.org/doc/year/22/22-101r1.txt . */ + if (!c_loc && !c_f_ptr && expr->rank > 0 && expr->expr_type == EXPR_VARIABLE) { gfc_array_ref *ar = gfc_find_array_ref (expr); - if (ar->type != AR_FULL) + if (ar->type == AR_FULL && ar->as->type == AS_ASSUMED_SIZE) { - *msg = "Only whole-arrays are interoperable"; - return false; - } - if (!c_f_ptr && ar->as->type != AS_EXPLICIT - && ar->as->type != AS_ASSUMED_SIZE) - { - *msg = "Only explicit-size and assumed-size arrays are interoperable"; + *msg = "Assumed-size arrays are not interoperable"; return false; } } @@ -5475,6 +5471,13 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) return false; } + if (attr.function) + { + gfc_error ("FPTR at %L to C_F_POINTER is a function returning a pointer", + &fptr->where); + return false; + } + if (fptr->rank > 0 && !is_c_interoperable (fptr, &msg, false, true)) return gfc_notify_std (GFC_STD_F2018, "Noninteroperable array FPTR " "at %L to C_F_POINTER: %s", &fptr->where, msg); diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 new file mode 100644 index 00000000000..bb6d3281b02 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! +! A function returning a pointer cannot be interoperable +! and cannot be used as FPTR argument to C_F_POINTER. + +subroutine s () + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr) :: cPtr + call c_f_pointer (cPtr, p0) ! { dg-error "function returning a pointer" } + call c_f_pointer (cPtr, p1, shape=[2]) ! { dg-error "function returning a pointer" } +contains + function p0 () + integer, pointer :: p0 + nullify (p0) + end + function p1 () + integer, pointer :: p1(:) + nullify (p1) + end +end diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_6.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_6.f90 index a676a5b8986..7043ac6ca99 100644 --- a/gcc/testsuite/gfortran.dg/c_sizeof_6.f90 +++ b/gcc/testsuite/gfortran.dg/c_sizeof_6.f90 @@ -8,7 +8,7 @@ program foo character(kind=c_char,len=1),parameter :: str2(4) = ["a","b","c","d"] - i = c_sizeof(str2(1:3)) ! { dg-error "must be an interoperable data" } + i = c_sizeof(str2(1:3)) if (i /= 3) STOP 1 diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_7.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_7.f90 new file mode 100644 index 00000000000..04a0bddbcaa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_sizeof_7.f90 @@ -0,0 +1,42 @@ +! { dg-do compile } +! PR fortran/106500 - fix checking of arguments to C_SIZEOF +! +! Check support of the following EDIT to 18-007r1: +! https://j3-fortran.org/doc/year/22/22-101r1.txt + +subroutine foo (n, x, y, z, w, u) + use, intrinsic :: iso_c_binding + implicit none + integer, intent(in) :: n + real :: x(n) + real :: y(:) + real :: z(2,*) + real :: w(..) + real, allocatable :: a(:) + real, pointer :: b(:) + type t + real, allocatable :: a(:) + end type t + type(t) :: u + + print *, c_sizeof (x) + print *, c_sizeof (x(::2)) + print *, c_sizeof (x+1) + print *, c_sizeof (y) + print *, c_sizeof (y(1:2)) + print *, c_sizeof (z(:,1:2)) + print *, c_sizeof (w) + print *, c_sizeof (1._c_float) + ! + allocate (a(n)) + allocate (b(n)) + if (.not. allocated (u%a)) allocate (u%a(n)) + print *, c_sizeof (a) + print *, c_sizeof (b) + ! + print *, c_sizeof (u%a) + print *, c_sizeof (u%a(1:2)) + ! + print *, c_sizeof (z) ! { dg-error "Assumed-size arrays are not interoperable" } + print *, c_sizeof (u) ! { dg-error "Expression is a noninteroperable derived type" } +end -- 2.35.3
