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);
--- /dev/null
+! { 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)"
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__(...))).
{
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);