From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Thu, 11 Jun 2020 10:05:40 +0000 (+0100)
Subject: Fortran  : ICE in gfc_check_pointer_assign PR95612
X-Git-Tag: releases/gcc-10.3.0~1128
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3eb264bd241598b27b765e198690a7cf4a2d91f8;p=thirdparty%2Fgcc.git

Fortran  : ICE in gfc_check_pointer_assign PR95612

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-27  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-27  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

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

(cherry picked from commit 81072bab8d1e48ee83d9711dcb559ea1e019b351)
---

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8daa7bb8d066..569f4d9bf066 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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
index 000000000000..b3cac8c1d814
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95612.f90
@@ -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
+