PR fortran/31304

	* fortran/gfortran.h (gfc_charlen_int_kind): New prototype.
	* fortran/trans-types.c (gfc_charlen_int_kind): New variable.
	(gfc_init_types): Define gfc_charlen_int_kind.
	* fortran/trans.h (gfor_fndecl_string_repeat): Remove prototype.
	* fortran/trans-decl.c (gfor_fndecl_string_repeat): Delete.
	(gfc_build_intrinsic_function_decls): Don't set
	gfor_fndecl_string_repeat.
	* fortran/trans-intrinsic.c (gfc_conv_intrinsic_repeat): Rewrite
	so that we don't have to call a library function.
	* fortran/simplify.c (gfc_simplify_repeat): Perform the necessary
	checks on the NCOPIES argument, and work with arbitrary size
	arguments.

	* intrinsics/string_intrinsics.c (string_repeat): Remove.

	* gfortran.dg/repeat_2.f90: New test.
	* gfortran.dg/repeat_3.f90: New test.
	* gfortran.dg/repeat_4.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2b113f4..f43ac73 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2007-04-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/31304
+       * fortran/gfortran.h (gfc_charlen_int_kind): New prototype.
+       * fortran/trans-types.c (gfc_charlen_int_kind): New variable.
+       (gfc_init_types): Define gfc_charlen_int_kind. 
+       * fortran/trans.h (gfor_fndecl_string_repeat): Remove prototype.
+       * fortran/trans-decl.c (gfor_fndecl_string_repeat): Delete.
+       (gfc_build_intrinsic_function_decls): Don't set
+       gfor_fndecl_string_repeat.
+       * fortran/trans-intrinsic.c (gfc_conv_intrinsic_repeat): Rewrite
+       so that we don't have to call a library function.
+       * fortran/simplify.c (gfc_simplify_repeat): Perform the necessary
+       checks on the NCOPIES argument, and work with arbitrary size
+       arguments.
+
 2007-03-31  Tobias Burnus  <burnus@net-b.de>
 
        * intrinsic.c (add_functions): Fix name of dummy argument

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd1d761..3ef4902 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1844,6 +1844,7 @@ extern int gfc_default_logical_kind;
 extern int gfc_default_complex_kind;
 extern int gfc_c_int_kind;
 extern int gfc_intio_kind;
+extern int gfc_charlen_int_kind;
 extern int gfc_numeric_storage_size;
 extern int gfc_character_storage_size;
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8c6847b..27f30ae 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2788,23 +2788,76 @@ gfc_expr *
 gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
 {
   gfc_expr *result;
-  int i, j, len, ncopies, nlen;
+  int i, j, len, ncop, nlen;
+  mpz_t ncopies;
 
-  if (e->expr_type != EXPR_CONSTANT || n->expr_type != EXPR_CONSTANT)
+  /* If NCOPIES isn't a constant, there's nothing we can do.  */
+  if (n->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (n != NULL && (gfc_extract_int (n, &ncopies) != NULL || ncopies < 0))
+  /* If NCOPIES is negative, it's an error.  */
+  if (mpz_sgn (n->value.integer) < 0)
     {
-      gfc_error ("Invalid second argument of REPEAT at %L", &n->where);
+      gfc_error ("Argument NCOPIES of REPEAT intrinsic is negative at %L",
+                &n->where);
       return &gfc_bad_expr;
     }
 
+  /* If we don't know the character length, we can do no more.  */
+  if (e->ts.cl == NULL || e->ts.cl->length == NULL
+      || e->ts.cl->length->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  /* If the source length is 0, any value of NCOPIES is valid
+     and everything behaves as if NCOPIES == 0.  */
+  mpz_init (ncopies);
+  if (mpz_sgn (e->ts.cl->length->value.integer) == 0)
+    mpz_set_ui (ncopies, 0);
+  else
+    mpz_set (ncopies, n->value.integer);
+
+  /* Check that NCOPIES isn't too large.  */
+  if (mpz_sgn (e->ts.cl->length->value.integer) != 0)
+    {
+      mpz_t max;
+      int i;
+
+      /* Compute the maximum value allowed for NCOPIES: huge(cl) / len.  */
+      mpz_init (max);
+      i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+      mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
+                 e->ts.cl->length->value.integer);
+
+      /* The check itself.  */
+      if (mpz_cmp (ncopies, max) > 0)
+       {
+         mpz_clear (max);
+         mpz_clear (ncopies);
+         gfc_error ("Argument NCOPIES of REPEAT intrinsic is too large at %L",
+                    &n->where);
+         return &gfc_bad_expr;
+       }
+
+      mpz_clear (max);
+    }
+  mpz_clear (ncopies);
+
+  /* For further simplication, we need the character string to be
+     constant.  */
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (mpz_sgn (e->ts.cl->length->value.integer) != 0)
+    gcc_assert (gfc_extract_int (n, &ncop) == NULL);
+  else
+    ncop = 0;
+
   len = e->value.character.length;
-  nlen = ncopies * len;
+  nlen = ncop * len;
 
   result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where);
 
-  if (ncopies == 0)
+  if (ncop == 0)
     {
       result->value.character.string = gfc_getmem (1);
       result->value.character.length = 0;
@@ -2815,7 +2868,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
   result->value.character.length = nlen;
   result->value.character.string = gfc_getmem (nlen + 1);
 
-  for (i = 0; i < ncopies; i++)
+  for (i = 0; i < ncop; i++)
     for (j = 0; j < len; j++)
       result->value.character.string[j + i * len]
       = e->value.character.string[j];

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index f8be3df..6cd1304 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -129,7 +129,6 @@ tree gfor_fndecl_string_index;
 tree gfor_fndecl_string_scan;
 tree gfor_fndecl_string_verify;
 tree gfor_fndecl_string_trim;
-tree gfor_fndecl_string_repeat;
 tree gfor_fndecl_adjustl;
 tree gfor_fndecl_adjustr;
 
@@ -2036,15 +2035,6 @@ gfc_build_intrinsic_function_decls (void)
                                      gfc_charlen_type_node,
                                      pchar_type_node);
 
-  gfor_fndecl_string_repeat =
-    gfc_build_library_function_decl (get_identifier (PREFIX("string_repeat")),
-                                     void_type_node,
-                                     4,
-                                     pchar_type_node,
-                                     gfc_charlen_type_node,
-                                     pchar_type_node,
-                                     gfc_int4_type_node);
-
   gfor_fndecl_ttynam =
     gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")),
                                      void_type_node,

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 4465030..25c8e1e 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3378,41 +3378,111 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
 {
-  tree gfc_int4_type_node = gfc_get_int_type (4);
-  tree tmp;
-  tree len;
-  tree args;
-  tree ncopies;
-  tree var;
-  tree type;
-  tree cond;
+  tree args, ncopies, dest, dlen, src, slen, ncopies_type;
+  tree type, cond, tmp, count, exit_label, n, max, largest;
+  stmtblock_t block, body;
+  int i;
 
+  /* Get the arguments.  */
   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.  */
+  slen = fold_convert (size_type_node, gfc_evaluate_now (TREE_VALUE (args),
+                                                        &se->pre));
+  src = TREE_VALUE (TREE_CHAIN (args));
+  ncopies = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args)));
   ncopies = gfc_evaluate_now (ncopies, &se->pre);
+  ncopies_type = TREE_TYPE (ncopies);
+
+  /* Check that NCOPIES is not negative.  */
   cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies,
-                     build_int_cst (TREE_TYPE (ncopies), 0));
+                     build_int_cst (ncopies_type, 0));
   gfc_trans_runtime_check (cond,
                           "Argument NCOPIES of REPEAT intrinsic is negative",
                           &se->pre, &expr->where);
 
+  /* If the source length is zero, any non negative value of NCOPIES
+     is valid, and nothing happens.  */
+  n = gfc_create_var (ncopies_type, "ncopies");
+  cond = fold_build2 (EQ_EXPR, boolean_type_node, slen,
+                     build_int_cst (size_type_node, 0));
+  tmp = fold_build3 (COND_EXPR, ncopies_type, cond,
+                    build_int_cst (ncopies_type, 0), ncopies);
+  gfc_add_modify_expr (&se->pre, n, tmp);
+  ncopies = n;
+
+  /* Check that ncopies is not too large: ncopies should be less than
+     (or equal to) MAX / slen, where MAX is the maximal integer of
+     the gfc_charlen_type_node type.  If slen == 0, we need a special
+     case to avoid the division by zero.  */
+  i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+  max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, gfc_charlen_int_kind);
+  max = fold_build2 (TRUNC_DIV_EXPR, size_type_node,
+                    fold_convert (size_type_node, max), slen);
+  largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type)
+             ? size_type_node : ncopies_type;
+  cond = fold_build2 (GT_EXPR, boolean_type_node,
+                     fold_convert (largest, ncopies),
+                     fold_convert (largest, max));
+  tmp = fold_build2 (EQ_EXPR, boolean_type_node, slen,
+                    build_int_cst (size_type_node, 0));
+  cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, boolean_false_node,
+                     cond);
+  gfc_trans_runtime_check (cond,
+                          "Argument NCOPIES of REPEAT intrinsic is too large",
+                          &se->pre, &expr->where);
+
   /* Compute the destination length.  */
-  len = fold_build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies);
+  dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, slen, ncopies);
   type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
-  var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
+  dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
+
+  /* Generate the code to do the repeat operation:
+       for (i = 0; i < ncopies; i++)
+         memmove (dest + (i * slen), src, slen);  */
+  gfc_start_block (&block);
+  count = gfc_create_var (ncopies_type, "count");
+  gfc_add_modify_expr (&block, count, build_int_cst (ncopies_type, 0));
+  exit_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Start the loop body.  */
+  gfc_start_block (&body);
 
-  /* Create the argument list and generate the function call.  */
-  tmp = build_call_expr (gfor_fndecl_string_repeat, 4, var,
-                        TREE_VALUE (args),
-                        TREE_VALUE (TREE_CHAIN (args)), ncopies);
+  /* Exit the loop if count >= ncopies.  */
+  cond = fold_build2 (GE_EXPR, boolean_type_node, count, ncopies);
+  tmp = build1_v (GOTO_EXPR, exit_label);
+  TREE_USED (exit_label) = 1;
+  tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp,
+                    build_empty_stmt ());
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Call memmove (dest + (i*slen), src, slen).  */
+  tmp = fold_build2 (MULT_EXPR, gfc_charlen_type_node, slen,
+                    fold_convert (gfc_charlen_type_node, count));
+  tmp = fold_build2 (PLUS_EXPR, pchar_type_node, dest,
+                    fold_convert (pchar_type_node, tmp));
+  tmp = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE], 3,
+                        tmp, src, slen);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Increment count.  */
+  tmp = build2 (PLUS_EXPR, ncopies_type, count,
+               build_int_cst (TREE_TYPE (count), 1));
+  gfc_add_modify_expr (&body, count, tmp);
+
+  /* Build the loop.  */
+  tmp = build1_v (LOOP_EXPR, gfc_finish_block (&body));
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Finish the block.  */
+  tmp = gfc_finish_block (&block);
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  se->expr = var;
-  se->string_length = len;
+  /* Set the result value.  */
+  se->expr = dest;
+  se->string_length = dlen;
 }
 
 

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 80cdb25..c0233a1 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -97,6 +97,9 @@ int gfc_c_int_kind;
    kind=8, this will be set to 8, otherwise it is set to 4.  */
 int gfc_intio_kind; 
 
+/* The integer kind used to store character lengths.  */
+int gfc_charlen_int_kind;
+
 /* The size of the numeric storage unit and character storage unit.  */
 int gfc_numeric_storage_size;
 int gfc_character_storage_size;
@@ -607,7 +610,8 @@ gfc_init_types (void)
   boolean_false_node = build_int_cst (boolean_type_node, 0);
 
   /* ??? Shouldn't this be based on gfc_index_integer_kind or so?  */
-  gfc_charlen_type_node = gfc_get_int_type (4);
+  gfc_charlen_int_kind = 4;
+  gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
 }
 
 /* Get the type node for the given type and kind.  */

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index a66ad39..97d4d0f 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -533,7 +533,6 @@ extern GTY(()) tree gfor_fndecl_string_index;
 extern GTY(()) tree gfor_fndecl_string_scan;
 extern GTY(()) tree gfor_fndecl_string_verify;
 extern GTY(()) tree gfor_fndecl_string_trim;
-extern GTY(()) tree gfor_fndecl_string_repeat;
 extern GTY(()) tree gfor_fndecl_adjustl;
 extern GTY(()) tree gfor_fndecl_adjustr;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1f3c024..b9c4127 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-04-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/31304
+       * gfortran.dg/repeat_2.f90: New test.
+       * gfortran.dg/repeat_3.f90: New test.
+       * gfortran.dg/repeat_4.f90: New test.
+
 2007-04-03  Uros Bizjak  <ubizjak@gmail.com>
 
        * gcc.dg/tls/opt-3.c: Use -mregparm=3 only for ilp32 on x86_64 targets.

diff --git a/gcc/testsuite/gfortran.dg/repeat_2.f90 b/gcc/testsuite/gfortran.dg/repeat_2.f90
new file mode 100644 (file)
index 0000000..d38718a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_2.f90
@@ -0,0 +1,92 @@
+! REPEAT intrinsic
+!
+! { dg-do run }
+subroutine foo(i, j, s, t)
+  implicit none
+  integer, intent(in) :: i, j
+  character(len=i), intent(in) :: s
+  character(len=i*j), intent(in) :: t
+
+  if (repeat(s,j) /= t) call abort
+  call bar(j,s,t)
+end subroutine foo
+
+subroutine bar(j, s, t)
+  implicit none
+  integer, intent(in) :: j
+  character(len=*), intent(in) :: s
+  character(len=len(s)*j), intent(in) :: t
+
+  if (repeat(s,j) /= t) call abort
+end subroutine bar
+
+program test
+  implicit none
+  character(len=0), parameter :: s0 = ""
+  character(len=1), parameter :: s1 = "a"
+  character(len=2), parameter :: s2 = "ab"
+  character(len=0) :: t0
+  character(len=1) :: t1
+  character(len=2) :: t2
+  integer :: i
+
+  t0 = ""
+  t1 = "a"
+  t2 = "ab"
+
+  if (repeat(t0, 0) /= "") call abort
+  if (repeat(t1, 0) /= "") call abort
+  if (repeat(t2, 0) /= "") call abort
+  if (repeat(t0, 1) /= "") call abort
+  if (repeat(t1, 1) /= "a") call abort
+  if (repeat(t2, 1) /= "ab") call abort
+  if (repeat(t0, 2) /= "") call abort
+  if (repeat(t1, 2) /= "aa") call abort
+  if (repeat(t2, 2) /= "abab") call abort
+
+  if (repeat(s0, 0) /= "") call abort
+  if (repeat(s1, 0) /= "") call abort
+  if (repeat(s2, 0) /= "") call abort
+  if (repeat(s0, 1) /= "") call abort
+  if (repeat(s1, 1) /= "a") call abort
+  if (repeat(s2, 1) /= "ab") call abort
+  if (repeat(s0, 2) /= "") call abort
+  if (repeat(s1, 2) /= "aa") call abort
+  if (repeat(s2, 2) /= "abab") call abort
+
+  i = 0
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "") call abort
+  if (repeat(t2, i) /= "") call abort
+  i = 1
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "a") call abort
+  if (repeat(t2, i) /= "ab") call abort
+  i = 2
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "aa") call abort
+  if (repeat(t2, i) /= "abab") call abort
+
+  i = 0
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "") call abort
+  if (repeat(s2, i) /= "") call abort
+  i = 1
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "a") call abort
+  if (repeat(s2, i) /= "ab") call abort
+  i = 2
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "aa") call abort
+  if (repeat(s2, i) /= "abab") call abort
+
+  call foo(0,0,"","")
+  call foo(0,1,"","")
+  call foo(0,2,"","")
+  call foo(1,0,"a","")
+  call foo(1,1,"a","a")
+  call foo(1,2,"a","aa")
+  call foo(2,0,"ab","")
+  call foo(2,1,"ab","ab")
+  call foo(2,2,"ab","abab")
+end program test

diff --git a/gcc/testsuite/gfortran.dg/repeat_3.f90 b/gcc/testsuite/gfortran.dg/repeat_3.f90
new file mode 100644 (file)
index 0000000..d571fc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_3.f90
@@ -0,0 +1,29 @@
+! REPEAT intrinsic, test for PR 31304
+! We check that REPEAT accepts all kind arguments for NCOPIES
+!
+! { dg-do run }
+program test
+  implicit none
+
+  integer(kind=1) i1
+  integer(kind=2) i2
+  integer(kind=4) i4
+  integer(kind=4) i8
+  real(kind=8) r
+  character(len=2) s1, s2
+
+  i1 = 1 ; i2 = 1 ; i4 = 1 ; i8 = 1
+  r = 1
+  s1 = '42'
+  r = nearest(r,r)
+
+  s2 = repeat(s1,i1)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i2)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i4)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i8)
+  if (s2 /= s1) call abort
+
+end program test

diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
new file mode 100644 (file)
index 0000000..de74d4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -0,0 +1,38 @@
+! REPEAT intrinsic -- various checks should be enforced
+!
+! { dg-do compile }
+program test
+  implicit none
+  character(len=0), parameter :: s0 = ""
+  character(len=1), parameter :: s1 = "a"
+  character(len=2), parameter :: s2 = "ab"
+  character(len=0) :: t0
+  character(len=1) :: t1
+  character(len=2) :: t2
+
+  t0 = "" ; t1 = "a" ; t2 = "ab"
+
+  ! Check for negative NCOPIES argument
+  print *, repeat(s0, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(s1, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(s2, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t0, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t1, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t2, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+
+  ! Check for too large NCOPIES argument and limit cases
+  print *, repeat(t0, huge(0))
+  print *, repeat(t1, huge(0))
+  print *, repeat(t2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+  print *, repeat(s2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+
+  print *, repeat(t0, huge(0)/2)
+  print *, repeat(t1, huge(0)/2)
+  print *, repeat(t2, huge(0)/2)
+
+  print *, repeat(t0, huge(0)/2+1)
+  print *, repeat(t1, huge(0)/2+1)
+  print *, repeat(t2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+  print *, repeat(s2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+
+end program test

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index d360b6c..87ad838 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2007-04-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/31304
+       intrinsics/string_intrinsics.c (string_repeat): Remove.
+
 2007-04-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/31052

diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index 86ef9d4..1a4b159 100644 (file)
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -73,9 +73,6 @@ export_proto(string_verify);
 extern void string_trim (GFC_INTEGER_4 *, void **, GFC_INTEGER_4, const char *);
 export_proto(string_trim);
 
-extern void string_repeat (char *, GFC_INTEGER_4, const char *, GFC_INTEGER_4);
-export_proto(string_repeat);
-
 /* Strings of unequal length are extended with pad characters.  */
 
 GFC_INTEGER_4
@@ -352,20 +349,3 @@ string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
 
   return 0;
 }
-
-
-/* Concatenate several copies of a string.  */
-
-void
-string_repeat (char * dest, GFC_INTEGER_4 slen, 
-               const char * src, GFC_INTEGER_4 ncopies)
-{
-  int i;
-
-  /* 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);
-    }
-}