Message ID | 438e0138-9304-2eca-0835-cabb13cf9031@netcologne.de |
---|---|
State | New |
Headers | show |
Series | [fortran] Fix PR 88669, rejects-valid | expand |
Am 27.01.19 um 14:18 schrieb Thomas Koenig: > Hello world, > > the attached, rather straightforward patch fixes a rejects-valid error > by fixing up the contiguous attribute for a class, and by using the > correct attributes. > > Regression-tested. OK for trunk? PING ** (4./7.)? Regards Thomas
On Thu, Jan 31, 2019 at 10:23:17PM +0100, Thomas Koenig wrote: > Am 27.01.19 um 14:18 schrieb Thomas Koenig: > > Hello world, > > > > the attached, rather straightforward patch fixes a rejects-valid error > > by fixing up the contiguous attribute for a class, and by using the > > correct attributes. > > > > Regression-tested. OK for trunk? > > PING ** (4./7.)? > OK.
Index: resolve.c =================================================================== --- resolve.c (Revision 268104) +++ resolve.c (Arbeitskopie) @@ -13761,6 +13761,7 @@ static bool resolve_component (gfc_component *c, gfc_symbol *sym) { gfc_symbol *super_type; + symbol_attribute *attr; if (c->attr.artificial) return true; @@ -13803,8 +13804,24 @@ resolve_component (gfc_component *c, gfc_symbol *s } /* F2008, C448. */ - if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer)) + if (c->ts.type == BT_CLASS) { + if (CLASS_DATA (c)) + { + attr = &(CLASS_DATA (c)->attr); + + /* Fix up contiguous attribute. */ + if (c->attr.contiguous) + attr->contiguous = 1; + } + else + attr = NULL; + } + else + attr = &c->attr; + + if (attr && attr->contiguous && (!attr->dimension || !attr->pointer)) + { gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but " "is not an array pointer", c->name, &c->loc); return false;