From: Harald Anlauf <anlauf@gmx.de>
To: gcc-patches@gcc.gnu.org
Cc: fortran@gcc.gnu.org
Subject: [PATCH, v2] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]
Date: Tue, 9 Apr 2024 23:23:54 +0200 [thread overview]
Message-ID: <2337004b-dfd8-45d1-b349-7c08e17353d9@gmx.de> (raw)
Message-ID: <20240409212354.CoqFm8j229LrBBBUeWKdhQsTVbbs45TZEaIZRPpOSLg@z> (raw)
In-Reply-To: <1BADB9B4-62BF-43FE-845F-545128503616@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1345 bytes --]
Hi FX!
On 4/9/24 09:32, FX Coudert wrote:
> Hi Harald,
>
> Thanks for the patch.
>
>
>> + 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);
>
>
> In both of these gfc_error(), could we change our error message to say "FPTR argument” instead of “FPTR”? “FPTR to C_F_POINTER” does not really make sense to me.
>
> This would be more in line with what the generally do:
>
>> Error: 'x' argument of 'sqrt' intrinsic at (1) must be REAL or COMPLEX
>
> So maybe “FPTR argument to C_F_POINTER at %L” ? That’s much more readable to me.
Good point! I did indeed feel a little uncomfortable with the text
and adjusted both messages accordingly to your suggestion.
I also forgot to add one update of a pattern, and found a cornercase
where the tightening of checks for C_F_POINTER was too strong.
Corrected and now covered in an extension of the corresponding testcase.
> Otherwise, OK.
>
> FX
Thanks for the review!
If there are no further comments, I will commit tomorrow.
Thanks,
Harald
[-- Attachment #2: pr106500-v2.diff --]
[-- Type: text/x-patch, Size: 7643 bytes --]
From 5983a07f11c88d920241141732fa742735cdb8ea Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 9 Apr 2024 23:07:59 +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,
and improve an error message.
gcc/testsuite/ChangeLog:
PR fortran/106500
* gfortran.dg/c_sizeof_6.f90: Remove wrong dg-error.
* gfortran.dg/sizeof_2.f90: Adjust pattern.
* gfortran.dg/c_f_pointer_tests_9.f90: New test.
* gfortran.dg/c_sizeof_7.f90: New test.
---
gcc/fortran/check.cc | 26 +++++++-----
.../gfortran.dg/c_f_pointer_tests_9.f90 | 37 ++++++++++++++++
gcc/testsuite/gfortran.dg/c_sizeof_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/c_sizeof_7.f90 | 42 +++++++++++++++++++
gcc/testsuite/gfortran.dg/sizeof_2.f90 | 2 +-
5 files changed, 96 insertions(+), 13 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..2f50d84b876 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,9 +5471,17 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
return false;
}
+ if (fptr->ts.type == BT_PROCEDURE && attr.function)
+ {
+ gfc_error ("FPTR argument to C_F_POINTER at %L 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);
+ return gfc_notify_std (GFC_STD_F2018,
+ "Noninteroperable array FPTR argument to "
+ "C_F_POINTER at %L: %s", &fptr->where, msg);
return true;
}
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..8c8b4a713a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
@@ -0,0 +1,37 @@
+! { 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
+ function fp0 ()
+ integer, pointer :: fp0
+ call c_f_pointer (cPtr, fp0) ! valid here
+ end
+ function fp1 ()
+ integer, pointer :: fp1(:)
+ call c_f_pointer (cPtr, fp1, shape=[2]) ! valid here
+ end
+ function ffp0 () result (fp0)
+ integer, pointer :: fp0
+ call c_f_pointer (cPtr, fp0) ! valid here
+ end
+ function ffp1 () result (fp1)
+ integer, pointer :: fp1(:)
+ call c_f_pointer (cPtr, fp1, shape=[2]) ! valid here
+ 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
diff --git a/gcc/testsuite/gfortran.dg/sizeof_2.f90 b/gcc/testsuite/gfortran.dg/sizeof_2.f90
index e6661a56b30..d1655c63449 100644
--- a/gcc/testsuite/gfortran.dg/sizeof_2.f90
+++ b/gcc/testsuite/gfortran.dg/sizeof_2.f90
@@ -15,7 +15,7 @@ subroutine foo(x, y)
ii = storage_size (x) ! { dg-error "Assumed-type argument at .1. is not permitted as actual argument to the intrinsic storage_size" }
ii = sizeof (y) ! { dg-error "shall not be an assumed-size array" }
- ii = c_sizeof (y) ! { dg-error "shall not be an assumed-size array" }
+ ii = c_sizeof (y) ! { dg-error "\[Aa\]ssumed-size array" }
ii = storage_size (y) ! okay, element-size is known
ii = sizeof (proc) ! { dg-error "shall not be a procedure" }
--
2.35.3
next prev parent reply other threads:[~2024-04-09 21:24 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-04-08 19:57 [PATCH] " Harald Anlauf
2024-04-09 7:32 ` FX Coudert
2024-04-09 21:23 ` Harald Anlauf [this message]
2024-04-09 21:23 ` [PATCH, v2] " Harald Anlauf
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=2337004b-dfd8-45d1-b349-7c08e17353d9@gmx.de \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).