From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id DDA903858D28; Mon, 8 Apr 2024 19:57:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org DDA903858D28 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org DDA903858D28 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.15 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1712606264; cv=none; b=HnPL/x4EomD0FW1Ru+wI0L0VYze9MzdC5xKg4QCaKOgy62W96FfQGFd+tLQrcQlOAYwhVAR4ya7WOcIVCa7NxymszpcpnAmP3wCT5rmW5HCDfTLKXboa13H9A1ZnJlGiGUpIwaeEDyHjm0ZIC0wUc6z3CAk4cXAeraSvzsTaP6U= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1712606264; c=relaxed/simple; bh=TVen4P9+6VyOi3Vo5z3UZRQoGCrYsAqA0IyfrCrU9Ig=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=jFasGqy2ZUk0jqmBCbQZheOl19NuXKGCG5dPMeuUpXcbexyy7NlajkOxTw2MhmCXj0WCkqsjfrAGIGazjVCyR+Dw5ewH25B5DOKnR2YPdBpi0l2fHZAgyO7vISQH4iLI9pcRMDHxUS58Ys74WJ+7MBImoh407jSJd1sikBeJ+xA= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1712606260; x=1713211060; i=anlauf@gmx.de; bh=kAZannyJq8JRpx1pKl+kbqBsh4Cet9kdn9VJzGFi7DI=; h=X-UI-Sender-Class:From:To:Subject:Date; b=fRBOGxX4FcltIGE/srdiKEVoghdB1o1wob8bncLs4i+Z/nbm5BEsMjPFnvq5y+il 1BAqG6e7UKOme4GU7DtB6asYnRKMLsnFc46Q2/UZGnDEQbID8SCQwGG1OH53tUFsH hDdQb7f+mZEhdIxn+JaRXRzQKD+5LViiudNbmWfbxD8nPQRcCppvoWPQdJr/KHpYa d7WBmCW8zu+GIUuXNyCSgfDCvFjTVttckqlBQ3GWbggzq8RmwXNxjaSREBkwG8wxe FajvK2hoyiZ3ctE74jD6c7NIQrNYVndgbuHFALULVHXV18lbb0OXbvMVQDAz1o8Bb p6+9+lE0zS/iXZPMyQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.91.66] ([93.207.91.66]) by web-mail.gmx.net (3c-app-gmx-bs14.server.lan [172.19.170.66]) (via HTTP); Mon, 8 Apr 2024 21:57:40 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500] Content-Type: multipart/mixed; boundary=rehcsed-570726ac-587f-4419-a5c2-ce3f8fe4b263 Date: Mon, 8 Apr 2024 21:57:40 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:NMUtn90hulMc7IjthTFu14Wwpa7M2TifTsKo/71o5uojCxv2FstY7vfPvB50ERZl7i0wn DEoL9gr2sXNj0UHYrM4UjCzjgdz4QKyWhJA3AM4XU60uKTQYK+7OVFiLzpp4Qd34A0/57PLY9BN/ J3KA4UPASMwF8GTFA6HksIqqNcMnZDaxYXf/NO91gYb0TLHt9Gyarjpx5e+JxlJMM0bE2gKxX43N sj8is9LOGsKQtYwy85Olr20zxRD+fiE8B38pGUL0a6TpjtklpkP2W/3kg9LOAIvg6fhc7tETbbvF E4= UI-OutboundReport: notjunk:1;M01:P0:BaexhulACnk=;LY8kdDdY+O92SxaC318eMxxGWyK /770HWeq1Uw0UilwrLENjpP2qmBfNMEfV57tuwcq+lrjtqR+AIvltGyoZxoV+sv3m2dTv9M2s Hz32G9FgeFSET4lXlazLUv5KBSQSDQL7TBQbuP2h1RfuNoNCa9luj3G5dZLVp4zAexMMkNYyM n97UePpSc6Hx5bx9RZF5nCmORiypAZm//aAcwP8DpuYYrVBGUczikGBGXHTsLEG0WwfT6MrpZ xdfEoeIcrdMTJPXpiWCaQamRHY8IK6JgsucamQ+ldGyGQ25LynOGEfQhq8ZrzX9RCpGRX+WAr 9DjmotCnUT2kyq/Q6woEe7Qeq08ctJXlM0jmKSdn8gW1j0CBbMZb+43bbRcFjCr8MY9ZuEaCc 6+3c9+2/xiKOvwbzdf3SPwNqJfzK4RAGbRMpq/VK8VJwJDtcE7DrSd3LCuNfOtlSWYNLTr4+1 FYSe/U6/Sj1xyIlTSsSx/ecFryUkA27qNCmVzIhGVZiWF7AcUdr1sIW+LHwNdRUHbzdjvrNRw +IZJjtVSP1KH6QjlK+rs0RsdwWEo2itzttIkGdqvYyqJzBOdkF4k/tcCx22Z+f0na17peyWAQ kV1wgkkZLdlmIrLNp/GjBrCFDReTgHBZJsCA+RC7/hyFQ42dR14FVgZwVwex10AdVMX/UMw2S R0Y3YrOfhW4atcHqPzRqyumCdCpfOPZQiZIMMPk2Rl2XYupGMZfMdSPSdLS6apk= X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --rehcsed-570726ac-587f-4419-a5c2-ce3f8fe4b263 Content-Type: text/plain; charset=UTF-8 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 --rehcsed-570726ac-587f-4419-a5c2-ce3f8fe4b263 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr106500.diff Content-Transfer-Encoding: quoted-printable =46rom 6f412a6399a7e125db835584d3d2489a52150c27 Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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 exte= nd 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. =2D-- 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 =2D-- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -5299,18 +5299,14 @@ is_c_interoperable (gfc_expr *expr, const char **m= sg, bool c_loc, bool c_f_ptr) return false; } - if (!c_loc && expr->rank > 0 && expr->expr_type !=3D 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 =3D=3D EXPR= _VARIABLE) { gfc_array_ref *ar =3D gfc_find_array_ref (expr); - if (ar->type !=3D AR_FULL) + if (ar->type =3D=3D AR_FULL && ar->as->type =3D=3D AS_ASSUMED_SIZE) { - *msg =3D "Only whole-arrays are interoperable"; - return false; - } - if (!c_f_ptr && ar->as->type !=3D AS_EXPLICIT - && ar->as->type !=3D AS_ASSUMED_SIZE) - { - *msg =3D "Only explicit-size and assumed-size arrays are interoperable= "; + *msg =3D "Assumed-size arrays are not interoperable"; return false; } } @@ -5475,6 +5471,13 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fp= tr, gfc_expr *shape) return false; } + if (attr.function) + { + gfc_error ("FPTR at %L to C_F_POINTER is a function returning a poi= nter", + &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/tests= uite/gfortran.dg/c_f_pointer_tests_9.f90 new file mode 100644 index 00000000000..bb6d3281b02 =2D-- /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=3D[2]) ! { dg-error "function returni= ng 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/gfor= tran.dg/c_sizeof_6.f90 index a676a5b8986..7043ac6ca99 100644 =2D-- 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=3Dc_char,len=3D1),parameter :: str2(4) =3D ["a","b","c"= ,"d"] - i =3D c_sizeof(str2(1:3)) ! { dg-error "must be an interoperable data"= } + i =3D c_sizeof(str2(1:3)) if (i /=3D 3) STOP 1 diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_7.f90 b/gcc/testsuite/gfor= tran.dg/c_sizeof_7.f90 new file mode 100644 index 00000000000..04a0bddbcaa =2D-- /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 interop= erable" } + print *, c_sizeof (u) ! { dg-error "Expression is a noninteroperable de= rived type" } +end =2D- 2.35.3 --rehcsed-570726ac-587f-4419-a5c2-ce3f8fe4b263--