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
From c73b248ec16388ed1ce109fce8a468a87e367085 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@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
