[multiple changes]

2015-10-01  Louis Krupp <louis.krupp@zoho.com>

	PR fortran/62242
	PR fortran/52332
	* trans-array.c
	(store_backend_decl): Create new gfc_charlen instance if requested
	(get_array_ctor_all_strlen): Call store_backend_decl requesting
	new gfc_charlen
	(trans_array_constructor): Call store_backend_decl requesting
	new gfc_charlen if get_array_ctor_strlen was called
	(gfc_add_loop_ss_code): Don't try to convert non-constant length

2015-10-01  Louis Krupp     <louis.krupp@zoho.com>

	PR fortran/62242
	PR fortran/52332
	* gfortran.dg/string_array_constructor_1.f90: New.
	* gfortran.dg/string_array_constructor_2.f90: New.
	* gfortran.dg/string_array_constructor_3.f90: New.

From-SVN: r228368

6 files changed, 149 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2b6a4b6..1e94355 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2015-10-01  Louis Krupp <louis.krupp@zoho.com>
+
+	PR fortran/62242
+	PR fortran/52332
+	* trans-array.c
+	(store_backend_decl): Create new gfc_charlen instance if requested
+	(get_array_ctor_all_strlen): Call store_backend_decl requesting
+	new gfc_charlen
+	(trans_array_constructor): Call store_backend_decl requesting
+	new gfc_charlen if get_array_ctor_strlen was called
+	(gfc_add_loop_ss_code): Don't try to convert non-constant length
+
 2015-10-01  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran.67802
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a6b761b..e1d7f78 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1799,6 +1799,29 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 }
 
 
+/* The array constructor code can create a string length with an operand
+   in the form of a temporary variable.  This variable will retain its
+   context (current_function_decl).  If we store this length tree in a
+   gfc_charlen structure which is shared by a variable in another
+   context, the resulting gfc_charlen structure with a variable in a
+   different context, we could trip the assertion in expand_expr_real_1
+   when it sees that a variable has been created in one context and
+   referenced in another.
+
+   If this might be the case, we create a new gfc_charlen structure and
+   link it into the current namespace.  */
+
+static void
+store_backend_decl (gfc_charlen **clp, tree len, bool force_new_cl)
+{
+  if (force_new_cl)
+    {
+      gfc_charlen *new_cl = gfc_new_charlen (gfc_current_ns, *clp);
+      *clp = new_cl;
+    }
+  (*clp)->backend_decl = len;
+}
+
 /* A catch-all to obtain the string length for anything that is not
    a substring of non-constant length, a constant, array or variable.  */
 
@@ -1836,7 +1859,7 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
       gfc_add_block_to_block (block, &se.pre);
       gfc_add_block_to_block (block, &se.post);
 
-      e->ts.u.cl->backend_decl = *len;
+      store_backend_decl (&e->ts.u.cl, *len, true);
     }
 }
 
@@ -2226,6 +2249,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   if (expr->ts.type == BT_CHARACTER)
     {
       bool const_string;
+      bool force_new_cl = false;
 
       /* get_array_ctor_strlen walks the elements of the constructor, if a
 	 typespec was given, we already know the string length and want the one
@@ -2244,14 +2268,17 @@ trans_array_constructor (gfc_ss * ss, locus * where)
 	  gfc_add_block_to_block (&outer_loop->post, &length_se.post);
 	}
       else
-	const_string = get_array_ctor_strlen (&outer_loop->pre, c,
-					      &ss_info->string_length);
+	{
+	  const_string = get_array_ctor_strlen (&outer_loop->pre, c,
+						&ss_info->string_length);
+	  force_new_cl = true;
+	}
 
       /* Complex character array constructors should have been taken care of
 	 and not end up here.  */
       gcc_assert (ss_info->string_length);
 
-      expr->ts.u.cl->backend_decl = ss_info->string_length;
+      store_backend_decl (&expr->ts.u.cl, ss_info->string_length, force_new_cl);
 
       type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length);
       if (const_string)
@@ -2589,7 +2616,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	  if (expr->ts.type == BT_CHARACTER
 	      && ss_info->string_length == NULL
 	      && expr->ts.u.cl
-	      && expr->ts.u.cl->length)
+	      && expr->ts.u.cl->length
+	      && expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
 	    {
 	      gfc_init_se (&se, NULL);
 	      gfc_conv_expr_type (&se, expr->ts.u.cl->length,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3df0caa..65a6a93 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2015-10-01  Louis Krupp     <louis.krupp@zoho.com>
+
+	PR fortran/62242
+	PR fortran/52332
+	* gfortran.dg/string_array_constructor_1.f90: New.
+	* gfortran.dg/string_array_constructor_2.f90: New.
+	* gfortran.dg/string_array_constructor_3.f90: New.
+
 2015-10-01  Segher Boessenkool  <segher@kernel.crashing.org>
 
 	PR target/67788
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90
new file mode 100755
index 0000000..a5968fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR 62242
+! Array constructor with an array element whose value is a
+! character function that is described in an interface block and which
+! has an assumed-length result
+module gfbug
+    implicit none
+    INTERFACE
+      function UpperCase(string) result(upper) 
+          character(*), intent(IN) :: string
+          character(LEN(string)) :: upper
+      end function
+      function f2(string) result(upper) 
+          character(*), intent(IN) :: string
+          character(5) :: upper
+      end function
+    END INTERFACE
+contains
+    subroutine s1
+        character(5) c
+        character(5), dimension(1) :: ca
+        ca = (/f2(c)/)  ! This compiles
+        ca = (/Uppercase(c)/) ! This gets an ICE
+    end subroutine
+end module gfbug
+
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90
new file mode 100755
index 0000000..0d352b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! PR 62242
+! Array constructor with an array element whose value is a
+! character function that is described in an interface block and which
+! has an assumed-length result
+module gfbug
+    implicit none
+    INTERFACE
+      function UpperCase(string) result(upper) 
+          character(*), intent(IN) :: string
+          character(LEN(string)) :: upper
+      end function
+      function f2(string) result(upper) 
+          character(*), intent(IN) :: string
+          character(5) :: upper
+      end function
+    END INTERFACE
+contains
+    subroutine s1
+        character(5) c
+        character(5), dimension(1) :: ca
+        character(5), dimension(1) :: cb
+        c = "12345"
+        ca = (/f2(c)/) ! This works
+        !print *, ca(1)
+        cb = (/Uppercase(c)/) ! This gets an ICE
+        if (ca(1) .ne. cb(1)) then
+            call abort()
+        end if
+        !print *, ca(1)
+    end subroutine
+end module gfbug
+
+function UpperCase(string) result(upper) 
+    character(*), intent(IN) :: string
+    character(LEN(string)) :: upper
+    upper = string
+end function
+function f2(string) result(upper) 
+    character(*), intent(IN) :: string
+    character(5) :: upper
+    upper = string
+end function
+
+program main
+    use gfbug
+    call s1
+end program
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90
new file mode 100644
index 0000000..1ba33e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! PR 62242
+! A subprogram calling an array constructor with an array element whose
+! value is the result of calling a character function with both an
+! assumed-length argument and an assumed-length result
+module gfbug
+    implicit none
+contains
+    function inner(inner_str) result(upper)
+        character(*), intent(IN) :: inner_str
+        character(LEN(inner_str)) :: upper
+
+        upper = '123'
+    end function
+
+    subroutine outer(outer_str)
+        character(*), intent(IN) :: outer_str
+        character(5) :: z(1)
+
+        z = [inner(outer_str)]
+    end subroutine
+end module gfbug