From f5da9bfb9e7b729db8243f656a1c7341e2d97655 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 11 Sep 2018 08:33:39 +0200 Subject: [PATCH] re PR fortran/86830 (Contiguous array pointer function result not recognized as contiguous) fix PR 86830 2018-09-11 Janus Weil PR fortran/86830 * expr.c (gfc_is_simply_contiguous): Handle type-bound procedure calls with non-polymorphic objects. 2018-09-11 Janus Weil PR fortran/86830 * gfortran.dg/typebound_call_30.f90: New test case. From-SVN: r264201 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/expr.c | 13 +++----- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/typebound_call_30.f90 | 32 +++++++++++++++++++ 4 files changed, 48 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_30.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 97d97e845bd..64acb7a2735 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-09-11 Janus Weil + + PR fortran/86830 + * expr.c (gfc_is_simply_contiguous): Handle type-bound procedure calls + with non-polymorphic objects. + 2018-09-10 Janus Weil PR fortran/85395 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 dd0f878abc5..2af919b99fe 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-11 Janus Weil + + PR fortran/86830 + * gfortran.dg/typebound_call_30.f90: New test case. + 2018-09-10 Janus Weil PR fortran/85395 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 -- 2.30.2