Fortran : ICE in gfc_check_pointer_assign PR95612
authorMark Eggleston <markeggleston@gcc.gnu.org>
Thu, 11 Jun 2020 10:05:40 +0000 (11:05 +0100)
committerMark Eggleston <markeggleston@gcc.gnu.org>
Tue, 14 Jul 2020 11:56:20 +0000 (12:56 +0100)
Output an error if the right hand value is a zero sized array or
does not have a symbol tree otherwise continue checking.

2020-07-14  Steven G. Kargl  <kargl@gcc.gnu.org>

gcc/fortran/

PR fortran/95612
* expr.c (gfc_check_pointer_assigb): Output an error if
rvalue is a zero sized array or output an error if rvalue
doesn't have a symbol tree.

2020-07-14  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

PR fortran/95612
* gfortran.dg/pr95612.f90: New test.

gcc/fortran/expr.c
gcc/testsuite/gfortran.dg/pr95612.f90 [new file with mode: 0644]

index 5bef65df86279f9a7042968a58b1033e733bcd4c..6707ca550a0f7696b1abd34a1788560276b7e310 100644 (file)
@@ -4271,7 +4271,20 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
       gfc_symbol *sym;
       bool target;
 
-      gcc_assert (rvalue->symtree);
+      if (gfc_is_size_zero_array (rvalue))
+       {
+         gfc_error ("Zero-sized array detected at %L where an entity with "
+                    "the TARGET attribute is expected", &rvalue->where);
+         return false;
+       }
+      else if (!rvalue->symtree)
+       {
+         gfc_error ("Pointer assignment target in initialization expression "
+                    "does not have the TARGET attribute at %L",
+                    &rvalue->where);
+         return false;
+       }
+
       sym = rvalue->symtree->n.sym;
 
       if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
diff --git a/gcc/testsuite/gfortran.dg/pr95612.f90 b/gcc/testsuite/gfortran.dg/pr95612.f90
new file mode 100644 (file)
index 0000000..b3cac8c
--- /dev/null
@@ -0,0 +1,7 @@
+! { dg-do compile }
+
+program p
+   integer, pointer :: y(:) => shape(1)   ! { dg-error "Zero-sized array detected at .1. where an entity with the TARGET attribute is expected" }
+   integer, pointer :: z(:) => shape([1]) ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute at .1." }
+end
+