2019-09-12 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/91686
	Backport from mainline
	* trans-expr.c (gfc_trans_assignment_1): Copy and paste section
	handling the rse.pre block from mainline.

2019-09-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91686
	* gfortran.dg/pr91686.f90 : New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-7-branch@275681 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 44 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e08a44a583c..7b65d541748 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-09-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/91686
+	Backport from mainline
+	* trans-expr.c (gfc_trans_assignment_1): Copy and paste section
+	handling the rse.pre block from mainline.
+
 2019-08-30  Jakub Jelinek  <jakub@redhat.com>
 
 	Backported from mainline
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e5a8cea422f..0946e6fa1e6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10165,19 +10165,27 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   /* When assigning a character function result to a deferred-length variable,
      the function call must happen before the (re)allocation of the lhs -
      otherwise the character length of the result is not known.
-     NOTE: This relies on having the exact dependence of the length type
+     NOTE 1: This relies on having the exact dependence of the length type
      parameter available to the caller; gfortran saves it in the .mod files.
-     NOTE ALSO: The concatenation operation generates a temporary pointer,
+     NOTE 2: Vector array references generate an index temporary that must
+     not go outside the loop. Otherwise, variables should not generate
+     a pre block.
+     NOTE 3: 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 4: Elemental functions may generate a temporary, too.  */
   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)
+	   && rss != gfc_ss_terminator
+	   && ((expr2->expr_type == EXPR_VARIABLE && expr2->rank)
+	       || (expr2->expr_type == EXPR_FUNCTION
+		   && expr2->value.function.esym != NULL
+		   && expr2->value.function.esym->attr.elemental)
 	       || (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 d24390fb2ba..4fe02996465 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-09-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/91686
+	* gfortran.dg/pr91686.f90 : New test.
+
 2019-09-11  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc.target/sparc/20161111-1.c: XFAIL redundant zero-extension test.
@@ -833,7 +838,7 @@
 
 	PR c++/60994
 	* g++.dg/lookup/pr60994.C: New test.
- 
+
 	2018-10-25  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/87725
@@ -1287,7 +1292,7 @@
 	* gcc.dg/torture/pr86554-2.c: Likewise.
 
 	2018-11-20  Richard Biener  <rguenther@suse.de>
- 
+
 	PR tree-optimization/88105
 	* gcc.dg/gomp/pr88105.c: New testcase.
 
diff --git a/gcc/testsuite/gfortran.dg/pr91686.f90 b/gcc/testsuite/gfortran.dg/pr91686.f90
new file mode 100644
index 00000000000..5dbd086296e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr91686.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+!
+! Test the fix for PR91686
+!
+! Contributed by  <urbanjost@comcast.net>
+!
+program shuf
+  implicit none
+  character(len=:),allocatable :: pageout(:)
+  integer                      :: i
+  pageout=[character(len=20) :: 'a','bbbbbbb','ccccc']
+  pageout=pageout([3,2,1])
+  if (trim( pageout(1)) .ne. 'ccccc') stop 1
+  if (trim( pageout(2)) .ne. 'bbbbbbb') stop 2
+  if (trim( pageout(3)) .ne. 'a') stop 3
+end program shuf