diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 27 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_5.f90 | 23 |
4 files changed, 60 insertions, 2 deletions
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 <tkoenig@gcc.gnu.org> + + 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 <rguenther@suse.de> 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 52ae4a1..dabd308 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-18 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/83012 + * gfortran.dg/contiguous_5.f90: New test. + 2017-11-17 Steve Ellcey <sellcey@cavium.com> * gcc.target/aarch64/fmls.c: New test. diff --git a/gcc/testsuite/gfortran.dg/contiguous_5.f90 b/gcc/testsuite/gfortran.dg/contiguous_5.f90 new file mode 100644 index 0000000..71d6d03 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_5.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! PR 83012 - this was incorrectly rejected. +! Original test case by Neil Carlson. +module mod + type :: foo + integer, pointer, contiguous :: p(:) + contains + procedure :: dataptr + end type +contains + function dataptr(this) result(dp) + class(foo), intent(in) :: this + integer, pointer, contiguous :: dp(:) + dp => this%p + end function +end module + +subroutine bar(x) + use mod + class(foo) :: x + integer, pointer, contiguous :: p(:) + p => x%dataptr() +end subroutine |