diff options
author | vehre <vehre@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-08-11 08:12:31 +0000 |
---|---|---|
committer | vehre <vehre@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-08-11 08:12:31 +0000 |
commit | bd10228c0f5e8fd43fa89f3669e90fb2d82a0ac9 (patch) | |
tree | 45ff81c38a0532e2c092b8db620f9fabbbafa2de | |
parent | 55e84e7a0585aa457003159c94a836beb145a4d8 (diff) |
gcc/fortran/ChangeLog:
2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org>
Backport from trunk:
PR fortran/71936
* trans-array.c (gfc_array_allocate): When SOURCE= is a function
stick with the ref of the object to allocate.
gcc/testsuite/ChangeLog:
2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org>
Backport from trunk:
PR fortran/71936
* gfortran.dg/allocate_with_source_21.f03: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-6-branch@239354 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 9 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 | 52 |
4 files changed, 73 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ced378822f9..6ce0d478da1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,12 @@ 2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> + Backport from trunk: + PR fortran/71936 + * trans-array.c (gfc_array_allocate): When SOURCE= is a function + stick with the ref of the object to allocate. + +2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> + Backport from trunk PR fortran/72698 * trans-stmt.c (gfc_trans_allocate): Prevent generating code for diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 89d528c1c9f..0882a3a0e7f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5421,12 +5421,19 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (ref->u.ar.type == AR_FULL && expr3 != NULL) { + gfc_ref *old_ref = ref; /* F08:C633: Array shape from expr3. */ ref = expr3->ref; /* Find the last reference in the chain. */ if (!retrieve_last_ref (&ref, &prev_ref)) - return false; + { + if (expr3->expr_type == EXPR_FUNCTION + && gfc_expr_attr (expr3).dimension) + ref = old_ref; + else + return false; + } alloc_w_e3_arr_spec = true; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 012bd6fcf0a..fa1aa4c4c5c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,12 @@ 2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> Backport from trunk: + PR fortran/71936 + * gfortran.dg/allocate_with_source_21.f03: New test. + +2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> + + Backport from trunk: PR fortran/72698 * gfortran.dg/allocate_with_source_20.f03: New test. diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 new file mode 100644 index 00000000000..fbf31593157 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 @@ -0,0 +1,52 @@ +! { dg-do compile } + +! Check fix for pr71936. +! Contributed by Gerhard Steinmetz + +program p + type t + end type + + call test2() + call test4() + call test1() + call test3() +contains + function f_p() + class(t), pointer :: f_p(:) + nullify(f_p) + end + + function f_a() + class(t), allocatable :: f_a(:) + end + + subroutine test1() + class(t), allocatable :: x(:) + allocate (x, mold=f_a()) + deallocate (x) + allocate (x, source=f_a()) + end subroutine + + subroutine test2() + class(t), pointer :: x(:) + allocate (x, mold=f_p()) + deallocate (x) + allocate (x, source=f_p()) + end + + subroutine test3() + class(t), pointer :: x(:) + allocate (x, mold=f_a()) + deallocate (x) + allocate (x, source=f_a()) + end + + subroutine test4() + class(t), allocatable :: x(:) + allocate (x, mold=f_p()) + deallocate (x) + allocate (x, source=f_p()) + end subroutine +end + |