From 7090cac9f7c9aabd4ad252e6d49b42bdcac85f67 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Mon, 8 Aug 2016 11:58:21 +0200 Subject: [PATCH] re PR fortran/71936 (ICE in wide_int_to_tree, at tree.c:1487) gcc/fortran/ChangeLog: 2016-08-08 Andre Vehreschild 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-08 Andre Vehreschild PR fortran/71936 * gfortran.dg/allocate_with_source_21.f03: New test. From-SVN: r239237 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-array.c | 9 +++- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/allocate_with_source_21.f03 | 52 +++++++++++++++++++ 4 files changed, 71 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3b54ee38c7e..6a56ed047a8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-08-08 Andre Vehreschild + + 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-08 Andre Vehreschild PR fortran/72698 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0a66f83562c..450d7db2076 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5431,12 +5431,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 6b7135cfeca..18f6e46e7bf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-08-08 Andre Vehreschild + + PR fortran/71936 + * gfortran.dg/allocate_with_source_21.f03: New test. + 2016-08-08 Andre Vehreschild PR fortran/72698 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 + -- 2.30.2