re PR fortran/86322 (ICE in reference_record with data statement)

2019-01-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/86322
	* decl.c (top_var_list): Set locus of expr.
	(gfc_match_data): Detect pointer on non-rightmost part-refs.

2019-01-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/86322
	* gfortran.dg/pr86322_1.f90: New test.
	* gfortran.dg/pr86322_2.f90: Ditto.
	* gfortran.dg/pr86322_3.f90: Ditto.

From-SVN: r267820

gcc/fortran/ChangeLog

@@ -1,3 +1,9 @@
+2019-01-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/86322
+	* decl.c (top_var_list): Set locus of expr.
+	(gfc_match_data): Detect pointer on non-rightmost part-refs.
+
 2019-01-09  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/88376

gcc/fortran/decl.c

@@ -337,6 +337,8 @@ top_var_list (gfc_data *d)
 
       new_var = gfc_get_data_variable ();
       *new_var = var;
+      if (new_var->expr)
+	new_var->expr->where = gfc_current_locus;
 
       if (tail == NULL)
 	d->var = new_var;
@@ -597,6 +599,7 @@ gfc_match_data (void)
 {
   gfc_data *new_data;
   gfc_expr *e;
+  gfc_ref *ref;
   match m;
 
   /* Before parsing the rest of a DATA statement, check F2008:c1206.  */
@@ -641,7 +644,7 @@ gfc_match_data (void)
 	  bool invalid;
 
 	  invalid = false;
-	  for (gfc_ref *ref = e->ref; ref; ref = ref->next)
+	  for (ref = e->ref; ref; ref = ref->next)
 	    if ((ref->type == REF_COMPONENT
 		 && ref->u.c.component->attr.allocatable)
 		|| (ref->type == REF_ARRAY
@@ -655,6 +658,21 @@ gfc_match_data (void)
 			 "near %C in DATA statement");
 	      goto cleanup;
 	    }
+
+	  /* F2008:C567 (R536) A data-i-do-object or a variable that appears
+	     as a data-stmt-object shall not be an object designator in which
+	     a pointer appears other than as the entire rightmost part-ref.  */
+	  ref = e->ref;
+	  if (e->symtree->n.sym->ts.type == BT_DERIVED
+	      && e->symtree->n.sym->attr.pointer
+	      && ref->type == REF_COMPONENT)
+	    goto partref;
+
+	  for (; ref; ref = ref->next)
+	    if (ref->type == REF_COMPONENT
+		&& ref->u.c.component->attr.pointer
+		&& ref->next)
+	      goto partref;
 	}
 
       m = top_val_list (new_data);
@@ -681,6 +699,12 @@ gfc_match_data (void)
 
   return MATCH_YES;
 
+partref:
+
+  gfc_error ("part-ref with pointer attribute near %L is not "
+	     "rightmost part-ref of data-stmt-object",
+	     &e->where);
+
 cleanup:
   set_in_match_data (false);
   gfc_free_data (new_data);

gcc/testsuite/ChangeLog

@@ -1,3 +1,10 @@
+2019-01-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/86322
+	* gfortran.dg/pr86322_1.f90: New test.
+	* gfortran.dg/pr86322_2.f90: Ditto.
+	* gfortran.dg/pr86322_3.f90: Ditto.
+
 2019-01-10  Sudakshina Das  <sudi.das@arm.com>
 
 	* gcc.target/aarch64/bti-1.c: Exempt for ilp32.

gcc/testsuite/gfortran.dg/pr86322_1.f90

@@ -0,0 +1,12 @@
+! { dg-do compile }
+program foo
+   implicit none
+   type a
+      integer i
+   end type a
+   type(a), target, save :: b
+   type(a), pointer :: c
+   data b%i /42/
+   data c%i /b%i/          ! { dg-error "is not rightmost part-ref" }
+   if (c%i == 42) c%i = 1  ! Unreachable
+end program foo

gcc/testsuite/gfortran.dg/pr86322_2.f90

@@ -0,0 +1,13 @@
+! { dg-do compile }
+program bar
+   type a
+     integer :: i
+   end type a
+   type b
+     type(a),pointer :: j
+   end type b
+   integer, target, save :: k = 42
+   type(b) x
+   data x%j%i/k/  ! { dg-error "is not rightmost part-ref" }
+   print *, x%j%i
+end program bar

gcc/testsuite/gfortran.dg/pr86322_3.f90

@@ -0,0 +1,13 @@
+! { dg-do run }
+program bar
+   type a
+     integer, pointer :: i
+   end type a
+   type b
+     type(a) :: j
+   end type b
+   integer, target, save :: k = 42
+   type(b) x
+   data x%j%i/k/
+   if (x%j%i /= 42) stop 1
+end program bar