re PR fortran/30611 ([4.1 only] Confusing error message for negative ncopies in REPEAT)

	PR fortran/30611

	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Evaluate
	arguments only once. Generate check that NCOPIES argument is not
	negative.

	* intrinsics/string_intrinsics.c (string_repeat): Don't check
	if ncopies is negative.

	* gcc/testsuite/gfortran.dg/repeat_1.f90: New test.

From-SVN: r121581

6 files changed, 55 insertions, 9 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 91140a7..a78ca2a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30611
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Evaluate
+	arguments only once. Generate check that NCOPIES argument is not
+	negative.
+
 2007-02-04  Steven G. Kargl <kargl@gcc.gnu.org>
 
 	* fortran/invoke.texi: Update documentation.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 6c321f1..aa8008b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3357,18 +3357,32 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
   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);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 40db44b..da8fdb0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30611
+	* gcc/testsuite/gfortran.dg/repeat_1.f90: New test.
+
 2007-02-04  Steven G. Kargl <kargl@gcc.gnu.org>
 
 	* gfortran.dg/spread_shape_1.f90: Remove tabs.
diff --git a/gcc/testsuite/gfortran.dg/repeat_1.f90 b/gcc/testsuite/gfortran.dg/repeat_1.f90
new file mode 100644
index 0000000..7a1d6f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-shouldfail "negative NCOPIES argument to REPEAT intrinsic" }
+  character(len=80) :: str
+  integer :: i
+  i = -1
+  write(str,"(a)") repeat ("a", f())
+  if (trim(str) /= "aaaa") call abort
+  write(str,"(a)") repeat ("a", i)
+
+contains
+
+  integer function f()
+    integer :: x = 5
+    save x
+
+    x = x - 1
+    f = x
+  end function f
+end
+! { dg-output "Fortran runtime error: Argument NCOPIES of REPEAT intrinsic is negative .* line 6)"
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 48b7e94..428d49a4 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,5 +1,11 @@
 2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
+	PR fortran/30611
+	* intrinsics/string_intrinsics.c (string_repeat): Don't check
+	if ncopies is negative.
+
+2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
 	PR libfortran/30007
 	* libgfortran.h: Do not prefix symbol name with
 	__USER_LABEL_PREFIX__ when used in __attribute__((__alias__(...))).
diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index e432987..86ef9d4 100644
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -362,14 +362,8 @@ string_repeat (char * dest, GFC_INTEGER_4 slen,
 {
   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);