re PR fortran/84109 (ICE in adjustl on allocatable array of strings)

2018-09-19  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/84109
	* gfortran.dg/elemental_function_3.f90 : New test.

From-SVN: r264427

gcc/fortran/ChangeLog

+2018-09-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	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  <tkoenig@gcc.gnu.org>
 
 	PR fortran/29550

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

gcc/testsuite/ChangeLog

+2018-09-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84109
+	* gfortran.dg/elemental_function_3.f90 : New test.
+
 2018-09-19  Marek Polacek  <polacek@redhat.com>
 
 	PR c++/87357 - missing -Wconversion warning

gcc/testsuite/gfortran.dg/elemental_function_3.f90

+! { 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  <wvermin@gmail.com>
+!
+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