From a814e35ba380d278f95e703efb0cb672987983f7 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 18 Nov 2017 15:53:21 +0000 Subject: [PATCH] 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 ++++++++++++++++++++-- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/contiguous_5.f90 | 23 ++++++++++++++++++ 4 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/contiguous_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd72b1cf0c3..8be551822b1 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 09abacf83ec..e1c0caccdc1 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 52ae4a1025f..dabd308f88a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-18 Thomas Koenig + + PR fortran/83012 + * gfortran.dg/contiguous_5.f90: New test. + 2017-11-17 Steve Ellcey * 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 00000000000..71d6d0374b5 --- /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 -- 2.30.2