From a814e35ba380d278f95e703efb0cb672987983f7 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 18 Nov 2017 15:53:21 +0000 Subject: re PR fortran/83012 (Simply contiguous pointer function not recognized as contiguous) 2017-11-18 Thomas Koenig PR fortran/83012 * expr.c (gfc_is_simply_contiguous): If a function call through a class variable is done through a reference, check the function's interface. 2017-11-18 Thomas Koenig PR fortran/83012 * gfortran.dg/contiguous_5.f90: New test. From-SVN: r254914 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/expr.c | 27 +++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd72b1c..8be5518 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-11-18 Thomas Koenig + + PR fortran/83012 + * expr.c (gfc_is_simply_contiguous): If a function call through a + class variable is done through a reference, check the function's + interface. + 2017-11-17 Richard Biener PR fortran/83017 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 09abacf..e1c0cac 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5207,8 +5207,31 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) gfc_symbol *sym; if (expr->expr_type == EXPR_FUNCTION) - return expr->value.function.esym - ? expr->value.function.esym->result->attr.contiguous : false; + { + if (expr->value.function.esym) + return expr->value.function.esym->result->attr.contiguous; + else + { + /* We have to jump through some hoops if this is a vtab entry. */ + gfc_symbol *s; + gfc_ref *r, *rc; + + s = expr->symtree->n.sym; + if (s->ts.type != BT_CLASS) + return false; + + rc = NULL; + for (r = expr->ref; r; r = r->next) + if (r->type == REF_COMPONENT) + rc = r; + + if (rc == NULL || rc->u.c.component == NULL + || rc->u.c.component->ts.interface == NULL) + return false; + + return rc->u.c.component->ts.interface->attr.contiguous; + } + } else if (expr->expr_type != EXPR_VARIABLE) return false; -- cgit v1.1