From: Paul Thomas Date: Wed, 19 Sep 2018 17:44:36 +0000 (+0000) Subject: re PR fortran/84109 (ICE in adjustl on allocatable array of strings) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ad9fe5f344c6ade92a8efab3202be356c94d5733;p=gcc.git re PR fortran/84109 (ICE in adjustl on allocatable array of strings) 2018-09-19 Paul Thomas PR fortran/84109 * trans-expr.c (gfc_trans_assignment_1): The rse.pre for the assignment of deferred character intrinsic elemental function results to a realocatable lhs must not be added to the exterior block if they are array valued but must go to the loop body. 2018-09-19 Paul Thomas PR fortran/84109 * gfortran.dg/elemental_function_3.f90 : New test. From-SVN: r264427 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4557bc2a5c8..15f060b89ff 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2018-09-19 Paul Thomas + + PR fortran/84109 + * trans-expr.c (gfc_trans_assignment_1): The rse.pre for the + assignment of deferred character intrinsic elemental function + results to a realocatable lhs must not be added to the exterior + block if they are array valued but must go to the loop body. + 2018-09-18 Thomas Koenig PR fortran/29550 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 144c666d77c..53b435947e9 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -10279,18 +10279,19 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, parameter available to the caller; gfortran saves it in the .mod files. NOTE ALSO: The concatenation operation generates a temporary pointer, whose allocation must go to the innermost loop. - NOTE ALSO (2): A character conversion may generate a temporary, too. */ + NOTE ALSO (2): Elemental functions may generate a temporary, too. */ if (flag_realloc_lhs && expr2->ts.type == BT_CHARACTER && expr1->ts.deferred && !(lss != gfc_ss_terminator + && rss != gfc_ss_terminator && ((expr2->expr_type == EXPR_FUNCTION && expr2->value.function.esym != NULL && expr2->value.function.esym->attr.elemental) - || (expr2->expr_type == EXPR_OP - && expr2->value.op.op == INTRINSIC_CONCAT) || (expr2->expr_type == EXPR_FUNCTION && expr2->value.function.isym != NULL - && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)))) + && expr2->value.function.isym->elemental) + || (expr2->expr_type == EXPR_OP + && expr2->value.op.op == INTRINSIC_CONCAT)))) gfc_add_block_to_block (&block, &rse.pre); /* Nullify the allocatable components corresponding to those of the lhs diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f52f37b6a1f..4631448bb67 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-19 Paul Thomas + + PR fortran/84109 + * gfortran.dg/elemental_function_3.f90 : New test. + 2018-09-19 Marek Polacek PR c++/87357 - missing -Wconversion warning diff --git a/gcc/testsuite/gfortran.dg/elemental_function_3.f90 b/gcc/testsuite/gfortran.dg/elemental_function_3.f90 new file mode 100644 index 00000000000..67bdd1ea86f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_function_3.f90 @@ -0,0 +1,44 @@ +! { dg-do run } +! +! Test the fix for PR84109 in which the call to the elemental function +! 'adjustl' was being added before the scalarization loop in the assignment. +! Since the result temporary was being declared in the loop body, this +! drove the gimplifier crazy. It is sufficient to compile this testcase +! since it used to ICE. This is the intrinsic counterpart to PR87239, +! which is tested for the absence of an ICE in elemental_function_2.f90. +! In this fix, a further improvement was to keep scalar calls outside the +! scalarization loop and this is tested with 'my_adjustl'. +! +! Contributed by Willem Vermin +! +program prog + implicit none + character(len=:), allocatable :: c(:) + integer :: cnt = 0 + + allocate(character(len=20) :: c(10)) + c = " ab " + c = adjustl(c) ! Used to ICE + if (trim (c(1)) .ne. "ab") stop 1 + + c = my_adjustl (" abcdefg ") + if (trim (c(1)) .ne. "abcdefg") stop 2 + if (cnt .ne. 1) stop 3 ! Outside the scalarization loop + if (size (c, 1) .ne. 10) stop 4 + if (len (c) .ne. 20) stop 5 + + cnt = 0 + c = my_adjustl ([" uv ", " xy "]) + if (trim (c(2)) .ne. "xy") stop 6 + if (cnt .ne. size (c, 1)) stop 7 ! Inside the scalarization loop + if (size (c, 1) .ne. 2) stop 8 + +contains + + impure elemental function my_adjustl(arg) result (res) + character(*), intent(in) :: arg + character(len = len (arg)) :: res + res = adjustl (arg) + cnt = cnt + 1 ! Test how many calls are made + end function +end program