From 20b1cbc33f4d16ccb359b70650d72988a2d4fbb1 Mon Sep 17 00:00:00 2001 From: "H.J. Lu" Date: Tue, 4 Apr 2006 21:47:51 -0700 Subject: [PATCH] re PR fortran/25619 (temporary array of constant size character type goes wrong) gcc/fortran/ 2006-04-04 H.J. Lu PR fortran/25619 * trans-array.c (gfc_conv_expr_descriptor): Only dereference character pointer when copying temporary. PR fortran/23634 * trans-array.c (gfc_conv_expr_descriptor): Properly copy temporary character with non constant size. gcc/testsuite/ 2006-04-04 Paul Thomas PR fortran/23634 PR fortran/25619 * gfortran.dg/actual_array_constructor_1.f90: New testcase. From-SVN: r112695 --- gcc/fortran/ChangeLog | 10 +++ gcc/fortran/trans-array.c | 40 +++++---- gcc/testsuite/ChangeLog | 6 ++ .../actual_array_constructor_1.f90 | 82 +++++++++++++++++++ 4 files changed, 123 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fe9ad51929c..0f09fef47aa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2006-04-04 H.J. Lu + + PR fortran/25619 + * trans-array.c (gfc_conv_expr_descriptor): Only dereference + character pointer when copying temporary. + + PR fortran/23634 + * trans-array.c (gfc_conv_expr_descriptor): Properly copy + temporary character with non constant size. + 2006-04-03 Paul Thomas PR fortran/26981 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5ebec62772b..4bdc784f11c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3973,23 +3973,32 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.temp_ss->next = gfc_ss_terminator; if (expr->ts.type == BT_CHARACTER) { - gcc_assert (expr->ts.cl && expr->ts.cl->length - && expr->ts.cl->length->expr_type == EXPR_CONSTANT); - loop.temp_ss->string_length = gfc_conv_mpz_to_tree - (expr->ts.cl->length->value.integer, - expr->ts.cl->length->ts.kind); - expr->ts.cl->backend_decl = loop.temp_ss->string_length; - } - loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); - - /* ... which can hold our string, if present. */ - if (expr->ts.type == BT_CHARACTER) - { - loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type); + if (expr->ts.cl + && expr->ts.cl->length + && expr->ts.cl->length->expr_type == EXPR_CONSTANT) + { + expr->ts.cl->backend_decl + = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer, + expr->ts.cl->length->ts.kind); + loop.temp_ss->data.temp.type + = gfc_typenode_for_spec (&expr->ts); + loop.temp_ss->string_length + = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type); + } + else + { + loop.temp_ss->data.temp.type + = gfc_typenode_for_spec (&expr->ts); + loop.temp_ss->string_length = expr->ts.cl->backend_decl; + } se->string_length = loop.temp_ss->string_length; } else - loop.temp_ss->string_length = NULL; + { + loop.temp_ss->data.temp.type + = gfc_typenode_for_spec (&expr->ts); + loop.temp_ss->string_length = NULL; + } loop.temp_ss->data.temp.dimen = loop.dimen; gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -4022,7 +4031,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (expr->ts.type == BT_CHARACTER) { gfc_conv_expr (&rse, expr); - rse.expr = build_fold_indirect_ref (rse.expr); + if (POINTER_TYPE_P (TREE_TYPE (rse.expr))) + rse.expr = build_fold_indirect_ref (rse.expr); } else gfc_conv_expr_val (&rse, expr); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 249932d6b80..da9fedb6c58 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2006-04-04 Paul Thomas + + PR fortran/23634 + PR fortran/25619 + * gfortran.dg/actual_array_constructor_1.f90: New testcase. + 2006-04-04 Eric Christopher * gcc.target/i386/387-1.c: Allow regexp to match darwin diff --git a/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90 new file mode 100644 index 00000000000..69bfcd05a53 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90 @@ -0,0 +1,82 @@ +! { dg-do run } +! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE +! that arose from a character array constructor usedas an actual +! argument. +! +! The various parts of this test are taken from the PRs. +! +! Test PR26491 +module global + public p, line + interface p + module procedure p + end interface + character(128) :: line = 'abcdefghijklmnopqrstuvwxyz' +contains + subroutine p() + character(128) :: word + word = line + call redirect_((/word/)) + end subroutine + subroutine redirect_ (ch) + character(*) :: ch(:) + if (ch(1) /= line) call abort () + end subroutine redirect_ +end module global + +! Test PR26550 +module my_module + implicit none + type point + real :: x + end type point + type(point), pointer, public :: stdin => NULL() +contains + subroutine my_p(w) + character(128) :: w + call r(stdin,(/w/)) + end subroutine my_p + subroutine r(ptr, io) + use global + type(point), pointer :: ptr + character(128) :: io(:) + if (associated (ptr)) call abort () + if (io(1) .ne. line) call abort () + end subroutine r +end module my_module + +program main + use global + use my_module + + integer :: i(6) = (/1,6,3,4,5,2/) + character (6) :: a = 'hello ', t + character(len=1) :: s(6) = (/'g','g','d','d','a','o'/) + equivalence (s, t) + + call option_stopwatch_s (a) ! Call test of PR25619 + call p () ! Call test of PR26491 + call my_p (line) ! Call test of PR26550 + +! Test Vivek Rao's bug, as reported in PR25619. + s = s(i) + call option_stopwatch_a ((/a,'hola! ', t/)) + +contains + +! Test PR23634 + subroutine option_stopwatch_s(a) + character (*), intent(in) :: a + character (len=len(a)) :: b + + b = 'hola! ' + call option_stopwatch_a((/a, b, 'goddag'/)) + end subroutine option_stopwatch_s + subroutine option_stopwatch_a (a) + character (*) :: a(:) + if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort () + end subroutine option_stopwatch_a + +end program main +! { dg-final { cleanup-modules "global my_module" } } + -- 2.30.2