re PR fortran/28118 (ICE calling subroutine defined via explicit interface)

2006-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28118
	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
	use the substring reference to calculate the length if the
	expression does not have a charlen.

2006-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28118
	* gfortran.dg/actual_array_substr_1.f90: New test.

From-SVN: r114964

4 files changed, 65 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73b8f7e..39e0209 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2006-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28118
+	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
+	use the substring reference to calculate the length if the
+	expression does not have a charlen.
+
 2006-06-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR fortran/28094
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 941e711..6a2c2de 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4184,9 +4184,37 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       loop.temp_ss->next = gfc_ss_terminator;
       if (expr->ts.type == BT_CHARACTER)
 	{
-	  if (expr->ts.cl
-	      && expr->ts.cl->length
-	      && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+	  if (expr->ts.cl == NULL)
+	    {
+	      /* This had better be a substring reference!  */
+	      gfc_ref *char_ref = expr->ref;
+	      for (; char_ref; char_ref = char_ref->next)
+		if (char_ref->type == REF_SUBSTRING)
+		  {
+		    mpz_t char_len;
+		    expr->ts.cl = char_ref->u.ss.length;
+		    mpz_init_set_ui (char_len, 1);
+		    mpz_add (char_len, char_len,
+			     char_ref->u.ss.end->value.integer);
+		    mpz_sub (char_len, char_len,
+			     char_ref->u.ss.start->value.integer);
+		    expr->ts.cl->backend_decl
+			= gfc_conv_mpz_to_tree (char_len,
+					gfc_default_character_kind);
+		    /* Cast is necessary for *-charlen refs.  */
+		    expr->ts.cl->backend_decl
+			= convert (gfc_charlen_type_node,
+				   expr->ts.cl->backend_decl);
+		    mpz_clear (char_len);
+		      break;
+		  }
+	      gcc_assert (char_ref != NULL);
+	      loop.temp_ss->data.temp.type
+		= gfc_typenode_for_spec (&expr->ts);
+	      loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+	    }
+	  else if (expr->ts.cl->length
+		     && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
 	    {
 	      expr->ts.cl->backend_decl
 		= gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1c8e7c4..2db5a7c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28118
+	* gfortran.dg/actual_array_substr_1.f90: New test.
+
 2006-06-24  Olivier Hainque  <hainque@adacore.com>
 
 	* gnat.dg/scalar_mode_agg_compare_loop.adb: New test.
diff --git a/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90
new file mode 100644
index 0000000..90108ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test fix of PR28118, in which a substring reference to an
+! actual argument with an array reference would cause a segfault.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program gfcbug33

+  character(12) :: a(2)
+  a(1) = "abcdefghijkl"
+  a(2) = "mnopqrstuvwx"
+  call foo ((a(2:1:-1)(6:)))
+  call bar ((a(:)(7:11)))
+contains
+  subroutine foo (chr)
+    character(7) :: chr(:)
+    if (chr(1)//chr(2) .ne. "rstuvwxfghijkl") call abort ()
+  end subroutine foo

+  subroutine bar (chr)
+    character(*) :: chr(:)
+    if (trim(chr(1))//trim(chr(2)) .ne. "ghijkstuvw") call abort ()
+  end subroutine bar

+end program gfcbug33