Committed as obviously.
2019-08-13 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/87991
* resolve.c (check_data_variable): data-stmt-object with pointer
attribute requires a data-stmt-value with the target attribute.
2019-08-13 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/87991
* gfortran.dg/pr87991.f90: New test.
--
Steve
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 274398)
+++ gcc/fortran/resolve.c (working copy)
@@ -15726,8 +15726,6 @@ check_data_variable (gfc_data_variable *var, locus *wh
return false;
}
- has_pointer = sym->attr.pointer;
-
if (gfc_is_coindexed (e))
{
gfc_error ("DATA element %qs at %L cannot have a coindex", sym->name,
@@ -15735,19 +15733,30 @@ check_data_variable (gfc_data_variable *var, locus *wh
return false;
}
+ has_pointer = sym->attr.pointer;
+
for (ref = e->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
has_pointer = 1;
- if (has_pointer
- && ref->type == REF_ARRAY
- && ref->u.ar.type != AR_FULL)
- {
- gfc_error ("DATA element %qs at %L is a pointer and so must "
- "be a full array", sym->name, where);
- return false;
- }
+ if (has_pointer)
+ {
+ if (ref->type == REF_ARRAY && ref->u.ar.type != AR_FULL)
+ {
+ gfc_error ("DATA element %qs at %L is a pointer and so must "
+ "be a full array", sym->name, where);
+ return false;
+ }
+
+ if (values.vnode->expr->expr_type == EXPR_CONSTANT)
+ {
+ gfc_error ("DATA object near %L has the pointer attribute "
+ "and the corresponding DATA value is not a valid "
+ "initial-data-target", where);
+ return false;
+ }
+ }
}
if (e->rank == 0 || has_pointer)
Index: gcc/testsuite/gfortran.dg/pr87991.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr87991.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr87991.f90 (working copy)
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-w" }
+! PR fortran/87991
+program p
+ type t
+ character(:), pointer :: c
+ end type
+ type(t) :: x
+ allocate (character(3) :: x%c)
+ data x%c /'abc'/ ! { dg-error "has the pointer attribute" }
+end
