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.

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index db74dcf3f40b97b146f9ba635b92bc70515190c9..2f50d84b876fc24d00a1aabe97512c00efba0415 100644 (file)
--- 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 (file)
index 0000000..8c8b4a7
--- /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 a676a5b89862a8a6980dfb3715209d54f84a6b48..7043ac6ca99a0018f4854ce39108a5dd95ee5e4b 100644 (file)
--- 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 (file)
index 0000000..04a0bdd
--- /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 e6661a56b30787801995dd537222a117feb7850f..d1655c63449c6c7d3308d2ea6df95f492de7cb92 100644 (file)
--- 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" }