]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: allow NULL() for POINTER, OPTIONAL, CONTIGUOUS dummy [PR111503]
authorHarald Anlauf <anlauf@gmx.de>
Fri, 8 Dec 2023 12:57:31 +0000 (13:57 +0100)
committerHarald Anlauf <anlauf@gmx.de>
Sun, 10 Dec 2023 19:24:53 +0000 (20:24 +0100)
gcc/fortran/ChangeLog:

PR fortran/111503
* expr.cc (gfc_is_simply_contiguous): Determine characteristics of
NULL() from optional MOLD argument, otherwise treat as contiguous.
* 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
gcc/fortran/primary.cc
gcc/testsuite/gfortran.dg/contiguous_14.f90 [new file with mode: 0644]

index c668baeef8c33a3d7d421243abd872f12c0cbc86..709f3c3cbef434cfa303dd45a3965c60651ac4d8 100644 (file)
@@ -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)
index 7278932b634a399b85790cd938960ed4ad657512..f8a1c09d190b38f50de44bcac0dd767a297905af 100644 (file)
@@ -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 (file)
index 0000000..21e4231
--- /dev/null
@@ -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