[PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]

[PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 750 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr106500.diff --]
[-- Type: text/x-patch, Size: 6257 bytes --]

From 6f412a6399a7e125db835584d3d2489a52150c27 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@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

Re: [PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]

[FX Coudert]

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.

Otherwise, OK.

FX

[PATCH, v2] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1381 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