diff mbox series

Fortran: allow NULL() for POINTER, OPTIONAL, CONTIGUOUS dummy [PR111503]

Message ID trinity-2066e8c2-df88-4d25-a5f0-60fe92102486-1702031284725@3c-app-gmx-bs48
State Accepted
Headers
Series Fortran: allow NULL() for POINTER, OPTIONAL, CONTIGUOUS dummy [PR111503] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Harald Anlauf Dec. 8, 2023, 10:28 a.m. UTC 
  Dear all,

here's another fix for the CONTIGUOUS attribute: NULL() should
derive its characteristics from its MOLD argument; otherwise it is
"determined by the entity with which the reference is associated".
(F2018:16.9.144).

The testcase is cross-checked with Intel.
NAG rejects cases where MOLD is a pointer.  I think it is wrong here.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

Comments

FX Coudert Dec. 8, 2023, 11:24 a.m. UTC | #1 
Hi Harald,

> here's another fix for the CONTIGUOUS attribute: NULL() should
> derive its characteristics from its MOLD argument; otherwise it is
> "determined by the entity with which the reference is associated".
> (F2018:16.9.144).

Looking good to me, but leave 48 hours for someone else to object if they want.

Best,
FX
diff mbox series

Patch

From c73b248ec16388ed1ce109fce8a468a87e367085 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 8 Dec 2023 11:11:08 +0100
Subject: [PATCH] Fortran: allow NULL() for POINTER, OPTIONAL, CONTIGUOUS dummy
 [PR111503]

gcc/fortran/ChangeLog:

	PR fortran/111503
	* expr.cc (gfc_is_simply_contiguous): Determine characteristics of
	NULL() from MOLD argument if present, otherwise treat as present.
	* primary.cc (gfc_variable_attr): Derive attributes of NULL(MOLD)
	from MOLD.

gcc/testsuite/ChangeLog:

	PR fortran/111503
	* gfortran.dg/contiguous_14.f90: New test.
---
 gcc/fortran/expr.cc                         | 14 ++++++++
 gcc/fortran/primary.cc                      |  4 ++-
 gcc/testsuite/gfortran.dg/contiguous_14.f90 | 39 +++++++++++++++++++++
 3 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/contiguous_14.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index c668baeef8c..709f3c3cbef 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5958,6 +5958,20 @@  gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
   if (expr->expr_type == EXPR_ARRAY)
     return true;

+  if (expr->expr_type == EXPR_NULL)
+    {
+      /* F2018:16.9.144  NULL ([MOLD]):
+	 "If MOLD is present, the characteristics are the same as MOLD."
+	 "If MOLD is absent, the characteristics of the result are
+	 determined by the entity with which the reference is associated."
+	 F2018:15.3.2.2 characteristics attributes include CONTIGUOUS.  */
+      if (expr->ts.type == BT_UNKNOWN)
+	return true;
+      else
+	return (gfc_variable_attr (expr, NULL).contiguous
+		|| gfc_variable_attr (expr, NULL).allocatable);
+    }
+
   if (expr->expr_type == EXPR_FUNCTION)
     {
       if (expr->value.function.isym)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 7278932b634..f8a1c09d190 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2627,7 +2627,9 @@  gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   gfc_component *comp;
   bool has_inquiry_part;

-  if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
+  if (expr->expr_type != EXPR_VARIABLE
+      && expr->expr_type != EXPR_FUNCTION
+      && !(expr->expr_type == EXPR_NULL && expr->ts.type != BT_UNKNOWN))
     gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");

   sym = expr->symtree->n.sym;
diff --git a/gcc/testsuite/gfortran.dg/contiguous_14.f90 b/gcc/testsuite/gfortran.dg/contiguous_14.f90
new file mode 100644
index 00000000000..21e42311e9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_14.f90
@@ -0,0 +1,39 @@ 
+! { dg-do compile }
+! PR fortran/111503 - passing NULL() to POINTER, OPTIONAL, CONTIGUOUS dummy
+
+program test
+  implicit none
+  integer, pointer, contiguous :: p(:) => null()
+  integer, allocatable, target :: a(:)
+  type t
+     integer, pointer, contiguous :: p(:) => null()
+     integer, allocatable         :: a(:)
+  end type t
+  type(t),               target :: z
+  class(t), allocatable, target :: c
+  print *, is_contiguous (p)
+  allocate (t :: c)
+  call one (p)
+  call one ()
+  call one (null ())
+  call one (null (p))
+  call one (a)
+  call one (null (a))
+  call one (z% p)
+  call one (z% a)
+  call one (null (z% p))
+  call one (null (z% a))
+  call one (c% p)
+  call one (c% a)
+  call one (null (c% p))
+  call one (null (c% a))
+contains
+  subroutine one (x)
+    integer, pointer, optional, contiguous, intent(in) :: x(:)
+    print *, present (x)
+    if (present (x)) then
+       print *, "->", associated (x)
+       if (associated (x)) stop 99
+    end if
+  end subroutine one
+end
--
2.35.3