diff mbox series

PR fortran/86322 -- Enforce F2018:C877

Message ID 20190110005702.GA27771@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/86322 -- Enforce F2018:C877 | expand

Commit Message

Steve Kargl Jan. 10, 2019, 12:57 a.m. UTC 
The attached patche fixes the PR.  gfortran was not enforcing
F2018:C877 and would ICE.  Tested on x86_64-*-freebsd.  Ok to
commit?

2019-01-09  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/86322
 * gfortran.dg/pr86322_1.f90: New test.
 * gfortran.dg/pr86322_2.f90: Ditto.
 * gfortran.dg/pr86322_3.f90: Ditto.

Comments

Thomas Koenig Jan. 10, 2019, 5:46 p.m. UTC | #1 
Hi Steve!

> The attached patche fixes the PR.  gfortran was not enforcing
> F2018:C877 and would ICE.  Tested on x86_64-*-freebsd.  Ok to
> commit?

OK.

Thanks for the patch!

Regards

	Thomas
diff mbox series

Patch

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 267779)
+++ gcc/fortran/decl.c	(working copy)
@@ -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);
@@ -680,6 +698,12 @@  gfc_match_data (void)
   gfc_unset_implicit_pure (gfc_current_ns->proc_name);
 
   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);
Index: gcc/testsuite/gfortran.dg/pr86322_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr86322_1.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr86322_1.f90	(working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/pr86322_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr86322_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr86322_2.f90	(working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/pr86322_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr86322_3.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr86322_3.f90	(working copy)
@@ -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