re PR fortran/47348 (wrong string length with array constructor)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Feb 2011 15:03:27 +0000 (15:03 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Feb 2011 15:03:27 +0000 (15:03 +0000)
2011-02-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/47348
* trans-array.c (get_array_ctor_all_strlen): Move up in file.
(get_array_ctor_var_strlen): Add block dummy and add call to
get_array_ctor_all_strlen instead of giving up on substrings.
Call gcc_unreachable for default case.
(get_array_ctor_strlen): Add extra argument to in call to
get_array_ctor_var_strlen.

2011-02-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/47348
* gfortran.dg/array_constructor_36.f90 : New test.
* gfortran.dg/bounds_check_10.f90 : Change dg-output message to
allow for comparison between different elements of the array
constructor at different levels of optimization.

From-SVN: r170317

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/array_constructor_36.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bounds_check_10.f90

index d7dff6d435d640a7077c33dfe2e8c08e21e23a9c..f8aa502dd4aab23931222a3e1961950ccccd4f53 100644 (file)
@@ -1,3 +1,13 @@
+2011-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/47348
+       * trans-array.c (get_array_ctor_all_strlen): Move up in file.
+       (get_array_ctor_var_strlen): Add block dummy and add call to
+       get_array_ctor_all_strlen instead of giving up on substrings.
+       Call gcc_unreachable for default case.
+       (get_array_ctor_strlen): Add extra argument to in call to
+       get_array_ctor_var_strlen.
+
 2011-02-18  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/47789
index 4dc69d25c267cf82e72f9b4b2a490f1eec357672..83f0189de757b01febe9b01f533efe6d63371f7e 100644 (file)
@@ -1495,11 +1495,55 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 }
 
 
+/* A catch-all to obtain the string length for anything that is not a
+   a substring of non-constant length, a constant, array or variable.  */
+
+static void
+get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
+{
+  gfc_se se;
+  gfc_ss *ss;
+
+  /* Don't bother if we already know the length is a constant.  */
+  if (*len && INTEGER_CST_P (*len))
+    return;
+
+  if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
+       && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+    {
+      /* This is easy.  */
+      gfc_conv_const_charlen (e->ts.u.cl);
+      *len = e->ts.u.cl->backend_decl;
+    }
+  else
+    {
+      /* Otherwise, be brutal even if inefficient.  */
+      ss = gfc_walk_expr (e);
+      gfc_init_se (&se, NULL);
+
+      /* No function call, in case of side effects.  */
+      se.no_function_call = 1;
+      if (ss == gfc_ss_terminator)
+       gfc_conv_expr (&se, e);
+      else
+       gfc_conv_expr_descriptor (&se, e, ss);
+
+      /* Fix the value.  */
+      *len = gfc_evaluate_now (se.string_length, &se.pre);
+
+      gfc_add_block_to_block (block, &se.pre);
+      gfc_add_block_to_block (block, &se.post);
+
+      e->ts.u.cl->backend_decl = *len;
+    }
+}
+
+
 /* Figure out the string length of a variable reference expression.
    Used by get_array_ctor_strlen.  */
 
 static void
-get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
+get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
 {
   gfc_ref *ref;
   gfc_typespec *ts;
@@ -1526,7 +1570,11 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
        case REF_SUBSTRING:
          if (ref->u.ss.start->expr_type != EXPR_CONSTANT
              || ref->u.ss.end->expr_type != EXPR_CONSTANT)
-           break;
+           {
+             /* Note that this might evaluate expr.  */
+             get_array_ctor_all_strlen (block, expr, len);
+             return;
+           }
          mpz_init_set_ui (char_len, 1);
          mpz_add (char_len, char_len, ref->u.ss.end->value.integer);
          mpz_sub (char_len, char_len, ref->u.ss.start->value.integer);
@@ -1536,10 +1584,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
          return;
 
        default:
-         /* TODO: Substrings are tricky because we can't evaluate the
-            expression more than once.  For now we just give up, and hope
-            we can figure it out elsewhere.  */
-         return;
+        gcc_unreachable ();
        }
     }
 
@@ -1547,49 +1592,6 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
 }
 
 
-/* A catch-all to obtain the string length for anything that is not a
-   constant, array or variable.  */
-static void
-get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
-{
-  gfc_se se;
-  gfc_ss *ss;
-
-  /* Don't bother if we already know the length is a constant.  */
-  if (*len && INTEGER_CST_P (*len))
-    return;
-
-  if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
-       && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
-    {
-      /* This is easy.  */
-      gfc_conv_const_charlen (e->ts.u.cl);
-      *len = e->ts.u.cl->backend_decl;
-    }
-  else
-    {
-      /* Otherwise, be brutal even if inefficient.  */
-      ss = gfc_walk_expr (e);
-      gfc_init_se (&se, NULL);
-
-      /* No function call, in case of side effects.  */
-      se.no_function_call = 1;
-      if (ss == gfc_ss_terminator)
-       gfc_conv_expr (&se, e);
-      else
-       gfc_conv_expr_descriptor (&se, e, ss);
-
-      /* Fix the value.  */
-      *len = gfc_evaluate_now (se.string_length, &se.pre);
-
-      gfc_add_block_to_block (block, &se.pre);
-      gfc_add_block_to_block (block, &se.post);
-
-      e->ts.u.cl->backend_decl = *len;
-    }
-}
-
-
 /* Figure out the string length of a character array constructor.
    If len is NULL, don't calculate the length; this happens for recursive calls
    when a sub-array-constructor is an element but not at the first position,
@@ -1633,7 +1635,7 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len
        case EXPR_VARIABLE:
          is_const = false;
          if (len)
-           get_array_ctor_var_strlen (c->expr, len);
+           get_array_ctor_var_strlen (block, c->expr, len);
          break;
 
        default:
index 8b6199f68187a92b2f9de7a306c763eed311c394..f1076f6ffdc80db501356358a248d3dfa43a32f6 100644 (file)
@@ -1,3 +1,21 @@
+2011-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/47348
+       * trans-array.c (get_array_ctor_all_strlen): Move up in file.
+       (get_array_ctor_var_strlen): Add block dummy and add call to
+       get_array_ctor_all_strlen instead of giving up on substrings.
+       Call gcc_unreachable for default case.
+       (get_array_ctor_strlen): Add extra argument to in call to
+       get_array_ctor_var_strlen.
+
+2011-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/47348
+       * gfortran.dg/array_constructor_36.f90 : New test.
+       * gfortran.dg/bounds_check_10.f90 : Change dg-output message to
+       allow for comparison between different elements of the array
+       constructor at different levels of optimization.
+
 2011-02-19  H.J. Lu  <hongjiu.lu@intel.com>
 
        * gcc.target/i386/pr31167.c: Require int128 instead of lp64.
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_36.f90 b/gcc/testsuite/gfortran.dg/array_constructor_36.f90
new file mode 100644 (file)
index 0000000..a74d256
--- /dev/null
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test the fix for PR47348, in which the substring length
+! in the array constructor at line 19 would be missed and
+! the length of q used instead.
+!
+! Contributed by Thomas Koenig  <tkoenig@netcologne.de>
+!
+program main
+  implicit none
+  character(len = *), parameter :: fmt='(2(A,"|"))'
+  character(len = *), parameter :: test='xyc|aec|'
+  integer :: i
+  character(len = 4) :: q
+  character(len = 8) :: buffer
+  q = 'xy'
+  i = 2
+  write (buffer, fmt) (/ trim(q), 'ae' /)//'c'
+  if (buffer .ne. test) Call abort
+  write (buffer, FMT) (/ q(1:i), 'ae' /)//'c'
+  if (buffer .ne. test) Call abort
+end program main
index 3aba1cb6ab602a5bfc0fde23aba3176ec5fe4a04..66bc308f060f59da1ea7cc44f99d1a1e1378ec01 100644 (file)
@@ -12,4 +12,4 @@ z = [y(1:1), y(1:1), x(1:len(trim(x)))]  ! should work
 z = [trim(x), trim(y), "aaaa"] ! [ "a", "cd", "aaaa" ] should catch first error
 end program array_char
 
-! { dg-output "Different CHARACTER lengths .1/2. in array constructor" }
+! { dg-output "Different CHARACTER lengths .1/.. in array constructor" }