diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7cfb94ee115..7e2d6445237 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-09-09 Janus Weil + + PR fortran/86830 + * expr.c (gfc_is_simply_contiguous): Handle type-bound procedure calls + with non-polymorphic objects. + 2018-09-03 Jerry DeLisle * simplify.c (gfc_simplify_modulo): Re-arrange code to test whether diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c5bf822cd24..97792fe32a7 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5385,16 +5385,13 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) 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) + /* Type-bound procedures. */ + gfc_symbol *s = expr->symtree->n.sym; + if (s->ts.type != BT_CLASS && s->ts.type != BT_DERIVED) return false; - rc = NULL; - for (r = expr->ref; r; r = r->next) + gfc_ref *rc = NULL; + for (gfc_ref *r = expr->ref; r; r = r->next) if (r->type == REF_COMPONENT) rc = r; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0c038441a8c..9e1ab44144f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-09 Janus Weil + + PR fortran/86830 + * gfortran.dg/typebound_call_30.f90: New test case. + 2018-09-08 Marek Polacek PR c++/87150 - wrong ctor with maybe-rvalue semantics. diff --git a/gcc/testsuite/gfortran.dg/typebound_call_30.f90 b/gcc/testsuite/gfortran.dg/typebound_call_30.f90 new file mode 100644 index 00000000000..3ca63bd2a95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_30.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! +! PR 86830: [8/9 Regression] Contiguous array pointer function result not recognized as contiguous +! +! Contributed by + +module m + implicit none + + type :: t1 + contains + procedure :: get_ptr + end type + + type :: t2 + class(t1), allocatable :: c + end type + +contains + + function get_ptr(this) + class(t1) :: this + real, dimension(:), contiguous, pointer :: get_ptr + end function + + subroutine test() + real, dimension(:), contiguous, pointer:: ptr + type(t2) :: x + ptr => x%c%get_ptr() + end subroutine + +end module