[Bug fortran/30611] Confusing error message for negative ncopies in REPEAT

[fxcoudert at gcc dot gnu dot org]

------- Comment #1 from fxcoudert at gcc dot gnu dot org  2007-02-01 13:51 -------
With a little variation, you get a better error message, although "augument"
part could be improved :)

$ cat u.f90
  integer :: i
  i = -1
  print *, repeat ("", i)
  end
$ gfortran u.f90 && ./a.out
Fortran runtime error: Augument NCOPIES is negative.

The following patch removes the check from the library, and makes the front-end
generate it instead: removes the weird error message, adds error location, more
easily optimized away.

More important: examination of the generated code revealed that REPEAT
evaluates it ncopies arguments multiple times (up to 3 times), which is
wrong-code:

  integer :: i
  i = -1
  print *, repeat ("a", f())
contains
  integer function f()
    integer :: x = 5
    save x

    x = x - 1
    f = x
  end function f
end

The above code prints out "aa" instead of "aaaa"; it segfaults if "x = 5" is
changed into "x = 3", for example. The patch below does also fix this
wrong-code issue. (We're not alone on this one, I found the same bug in Sun and
Portland compilers)



Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c       (revision 121280)
+++ gcc/fortran/trans-intrinsic.c       (working copy)
@@ -3357,18 +3357,32 @@
   tree ncopies;
   tree var;
   tree type;
+  tree cond;

   args = gfc_conv_intrinsic_function_args (se, expr);
   len = TREE_VALUE (args);
   tmp = gfc_advance_chain (args, 2);
   ncopies = TREE_VALUE (tmp);
+
+  /* Check that ncopies is not negative.  */
+  ncopies = gfc_evaluate_now (ncopies, &se->pre);
+  cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies,
+                     build_int_cst (TREE_TYPE (ncopies), 0));
+  gfc_trans_runtime_check (cond,
+                          "Argument NCOPIES of REPEAT intrinsic is negative",
+                          &se->pre, &expr->where);
+
+  /* Compute the destination length.  */
   len = fold_build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies);
   type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
   var = gfc_conv_string_tmp (se, build_pointer_type (type), len);

+  /* Create the argument list and generate the function call.  */
   arglist = NULL_TREE;
   arglist = gfc_chainon_list (arglist, var);
-  arglist = chainon (arglist, args);
+  arglist = gfc_chainon_list (arglist, TREE_VALUE(args));
+  arglist = gfc_chainon_list (arglist, TREE_VALUE(TREE_CHAIN(args)));
+  arglist = gfc_chainon_list (arglist, ncopies);
   tmp = build_function_call_expr (gfor_fndecl_string_repeat, arglist);
   gfc_add_expr_to_block (&se->pre, tmp);

Index: libgfortran/intrinsics/string_intrinsics.c
===================================================================
--- libgfortran/intrinsics/string_intrinsics.c  (revision 121280)
+++ libgfortran/intrinsics/string_intrinsics.c  (working copy)
@@ -362,14 +362,8 @@
 {
   int i;

-  /* See if ncopies is valid.  */
-  if (ncopies < 0)
-    {
-      /* The error is already reported.  */
-      runtime_error ("Augument NCOPIES is negative.");
-    }
-
-  /* Copy characters.  */
+  /* We don't need to check that ncopies is non-negative here, because
+     the front-end already generates code for that check.  */
   for (i = 0; i < ncopies; i++) 
     {
       memmove (dest + (i * slen), src, slen);


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |fxcoudert at gcc dot gnu dot
                   |                            |org
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
           Keywords|                            |wrong-code
      Known to fail|                            |4.3.0 4.2.0 4.1.2
   Last reconfirmed|0000-00-00 00:00:00         |2007-02-01 13:51:13
               date|                            |
   Target Milestone|---                         |4.2.0


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30611