mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-25 11:54:01 +08:00
re PR fortran/31304 (REPEAT argument NCOPIES is not converted as it should)
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. From-SVN: r123481
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
ff2ea58742
commit
f1412ca58a
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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];
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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);
|
||||
|
||||
/* 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);
|
||||
/* 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;
|
||||
|
||||
/* 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);
|
||||
/* 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. */
|
||||
dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, slen, ncopies);
|
||||
type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
|
||||
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);
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -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. */
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
92
gcc/testsuite/gfortran.dg/repeat_2.f90
Normal file
92
gcc/testsuite/gfortran.dg/repeat_2.f90
Normal file
@ -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
|
||||
29
gcc/testsuite/gfortran.dg/repeat_3.f90
Normal file
29
gcc/testsuite/gfortran.dg/repeat_3.f90
Normal file
@ -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
|
||||
38
gcc/testsuite/gfortran.dg/repeat_4.f90
Normal file
38
gcc/testsuite/gfortran.dg/repeat_4.f90
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user