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 <ka...@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 <ka...@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.
--
Steve
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
