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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114964 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73b8f7e..39e0209 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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\r
+  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\r
+  subroutine bar (chr)
+    character(*) :: chr(:)
+    if (trim(chr(1))//trim(chr(2)) .ne. "ghijkstuvw") call abort ()
+  end subroutine bar\r
+end program gfcbug33\r