re PR fortran/87239 (ICE in deferred-length string)

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

	PR fortran/87239
	* trans-expr.c (gfc_trans_assignment_1): The rse.pre for the
	assignment of deferred character elemental function results to
	a realocatable lhs must not be added to the exterior block but
	must go to the loop body.

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

	PR fortran/87239
	* gfortran.dg/elemental_function_2.f90 : New test.

From-SVN: r264409

4 files changed, 57 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5f10add..b89ecf8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2018-09-18  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/87239
+	* trans-expr.c (gfc_trans_assignment_1): The rse.pre for the
+	assignment of deferred character elemental function results to
+	a realocatable lhs must not be added to the exterior block but
+	must go to the loop body.
+
+2018-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/87336
 	* trans-array.c (gfc_get_array_span): Try to get the element
 	length of incomplete types. Return NULL_TREE otherwise.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 35052a8..144c666 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10283,8 +10283,11 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   if (flag_realloc_lhs
       && expr2->ts.type == BT_CHARACTER && expr1->ts.deferred
       && !(lss != gfc_ss_terminator
-	   && ((expr2->expr_type == EXPR_OP
-		&& expr2->value.op.op == INTRINSIC_CONCAT)
+	   && ((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))))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index af072db..2be6461 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,18 +1,7 @@
-2018-09-18  Marek Polacek  <polacek@redhat.com>
-
-	P1064R0 - Allowing Virtual Function Calls in Constant Expressions
-	* g++.dg/cpp0x/constexpr-virtual5.C: Adjust dg-error.
-	* g++.dg/cpp2a/constexpr-virtual1.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual2.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual3.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual4.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual5.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual6.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual7.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual8.C: New test.
-	* g++.dg/cpp2a/constexpr-virtual9.C: New test.
-	* g++.dg/diagnostic/virtual-constexpr.C: Skip for C++2a.  Use
-	-pedantic-errors.  Adjust dg-error.
+2018-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/87239
+	* gfortran.dg/elemental_function_2.f90 : New test.
 
 2018-09-18  Paul Thomas  <pault@gcc.gnu.org>
 
diff --git a/gcc/testsuite/gfortran.dg/elemental_function_2.f90 b/gcc/testsuite/gfortran.dg/elemental_function_2.f90
new file mode 100644
index 0000000..7836ce8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_function_2.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! Test the fix for PR87239 in which the call to the elemental function
+! 'gettwo' 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.
+!
+! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+!
+module test
+  implicit none
+contains
+
+  elemental function gettwo( s ) result( res )
+    character(*), intent(in) :: s
+    character(len(s)) :: res
+
+    res = s( 1 : 2 )
+  endfunction gettwo
+
+endmodule test
+
+program main
+  use test
+  implicit none
+  character(10) :: inp( 5 )
+  integer :: i
+
+  ! character(10), allocatable :: out(:) ! this works
+  character(:), allocatable :: out(:) ! this was stuffed
+
+  inp = [ 'aaa', 'bbb', 'ccc', 'ddd', 'eee' ]
+
+  out = gettwo( inp )
+
+  do i = 1, size (out, 1)
+    if (trim (out(i)) .ne. inp(i)(1:2)) stop 1
+  end do
+endprogram main