[Patch, fortran] PR28118 - ICE calling subroutine defined via explicit interface

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran

I was more than a little surprised to find that we had not encountered this
one before!

 character(12) :: a(2)
 call foo (a(:)(7:11))
end 

(gdb) run PR28118.f90
Starting program: /irun/libexec/gcc/i686-pc-cygwin/4.2.0/f951.exe PR28118.f90
MAIN__
Program received signal SIGSEGV, Segmentation fault.
0x0048a297 in gfc_conv_expr_descriptor (se=0x22eb70, expr=0x101ff150,
   ss=0x1020f730) at ../../trunk/gcc/fortran/trans-array.c:4203
4203                  loop.temp_ss->string_length = expr->ts.cl->backend_decl;


The problem comes about because we try to make a temporary in
gfc_conv_expr_descriptor, without a character length, pointed to by the
expression's typespec.  The patch remedies that by calculating the length
of the substring from the substring reference. The testcase is a
straightforward test that the string length is correctly calculated and
that the string temporary is properly organised.

Regtested on FC5/athlon1700 - OK for trunk and 4.1?

Paul

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

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

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

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


Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(révision 114814)
+++ gcc/fortran/trans-array.c	(copie de travail)
@@ -4184,10 +4184,38 @@
       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,
 					expr->ts.cl->length->ts.kind);

! { 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