diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2018-09-11 08:33:39 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2018-09-11 08:33:39 +0200 |
| commit | f5da9bfb9e7b729db8243f656a1c7341e2d97655 (patch) | |
| tree | 5ec7bac40b1c423111fc052dbe818d0d620b71a8 /gcc | |
| parent | 672ce110a853a23adf8b43c58c48957258d9bf86 (diff) | |
| download | gcc-f5da9bfb9e7b729db8243f656a1c7341e2d97655.zip gcc-f5da9bfb9e7b729db8243f656a1c7341e2d97655.tar.gz gcc-f5da9bfb9e7b729db8243f656a1c7341e2d97655.tar.bz2 | |
re PR fortran/86830 (Contiguous array pointer function result not recognized as contiguous)
fix PR 86830
2018-09-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/86830
* expr.c (gfc_is_simply_contiguous): Handle type-bound procedure calls
with non-polymorphic objects.
2018-09-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/86830
* gfortran.dg/typebound_call_30.f90: New test case.
From-SVN: r264201
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 13 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_call_30.f90 | 32 |
4 files changed, 48 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 97d97e8..64acb7a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-09-11 Janus Weil <janus@gcc.gnu.org> + + PR fortran/86830 + * expr.c (gfc_is_simply_contiguous): Handle type-bound procedure calls + with non-polymorphic objects. + 2018-09-10 Janus Weil <janus@gcc.gnu.org> PR fortran/85395 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c5bf822..97792fe 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 dd0f878..2af919b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-11 Janus Weil <janus@gcc.gnu.org> + + PR fortran/86830 + * gfortran.dg/typebound_call_30.f90: New test case. + 2018-09-10 Janus Weil <janus@gcc.gnu.org> 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 0000000..3ca63bd --- /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 <only_for_nouse@gmx.de> + +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 |