re PR fortran/30389 ([4.1 only] ACHAR() intrinsic gives erroneous errors in constant-folding.)
2007-01-28 Thomas Koenig <Thomas.Koenig@online.de> PR libfortran/30389 * gfortran.h: Remove gfc_simplify_init_1. * arith.h: Remove third argument from gfc_compare_string. * arith.c(gfc_compare_expression): Remove third argument from call to gfc_compare_string. (gfc_compare_string): Remove third argument xcoll_table. Remove use of xcoll_table. * misc.c(gfc_init_1): Remove call to gfc_simplify_init_1. * simplify.c(ascii_table): Remove. (xascii_table): Likewise. (gfc_simplify_achar): ICE if extract_int fails. Remove use of ascii_table. Warn if -Wsurprising and value < 0 or > 127. (gfc_simplify_char): ICE if extract_int fails. Error if value < 0 or value > 255. (gfc_simplify_iachar): Remove use of xascii_table. Char values outside of 0..255 are an ICE. (gfc_simplify_lge): Remove use of xascii_table. (gfc_simplify_lgt): Likewise. (gfc_simplify_lle): Likewise. (gfc_simplify_llt): Likewise. (invert_table): Remove. (gfc_simplify_init_1): Remove. 2007-01-28 Thomas Koenig <Thomas.Koenig@online.de> PR libfortran/30389 * gfortran.dg/achar_2.f90: New test. * gfortran.dg/achar_3.f90: New test. From-SVN: r121255
This commit is contained in:
Thomas Koenig
Thomas Koenig
parent
eeef0e452e
commit
34462c28df
@ -1,3 +1,28 @@
|
||||
2007-01-28 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR libfortran/30389
|
||||
* gfortran.h: Remove gfc_simplify_init_1.
|
||||
* arith.h: Remove third argument from gfc_compare_string.
|
||||
* arith.c(gfc_compare_expression): Remove third argument
|
||||
from call to gfc_compare_string.
|
||||
(gfc_compare_string): Remove third argument xcoll_table.
|
||||
Remove use of xcoll_table.
|
||||
* misc.c(gfc_init_1): Remove call to gfc_simplify_init_1.
|
||||
* simplify.c(ascii_table): Remove.
|
||||
(xascii_table): Likewise.
|
||||
(gfc_simplify_achar): ICE if extract_int fails. Remove use of
|
||||
ascii_table. Warn if -Wsurprising and value < 0 or > 127.
|
||||
(gfc_simplify_char): ICE if extract_int fails. Error if
|
||||
value < 0 or value > 255.
|
||||
(gfc_simplify_iachar): Remove use of xascii_table.
|
||||
Char values outside of 0..255 are an ICE.
|
||||
(gfc_simplify_lge): Remove use of xascii_table.
|
||||
(gfc_simplify_lgt): Likewise.
|
||||
(gfc_simplify_lle): Likewise.
|
||||
(gfc_simplify_llt): Likewise.
|
||||
(invert_table): Remove.
|
||||
(gfc_simplify_init_1): Remove.
|
||||
|
||||
2007-01-27 Roger Sayle <roger@eyesopen.com>
|
||||
|
||||
* trans-stmt.c (forall_info): Replace the next_nest and outer
|
||||
|
||||
@ -1055,7 +1055,7 @@ gfc_compare_expr (gfc_expr *op1, gfc_expr *op2)
|
||||
break;
|
||||
|
||||
case BT_CHARACTER:
|
||||
rc = gfc_compare_string (op1, op2, NULL);
|
||||
rc = gfc_compare_string (op1, op2);
|
||||
break;
|
||||
|
||||
case BT_LOGICAL:
|
||||
@ -1083,11 +1083,11 @@ compare_complex (gfc_expr *op1, gfc_expr *op2)
|
||||
|
||||
|
||||
/* Given two constant strings and the inverse collating sequence, compare the
|
||||
strings. We return -1 for a < b, 0 for a == b and 1 for a > b. If the
|
||||
xcoll_table is NULL, we use the processor's default collating sequence. */
|
||||
strings. We return -1 for a < b, 0 for a == b and 1 for a > b.
|
||||
We use the processor's default collating sequence. */
|
||||
|
||||
int
|
||||
gfc_compare_string (gfc_expr *a, gfc_expr *b, const int *xcoll_table)
|
||||
gfc_compare_string (gfc_expr *a, gfc_expr *b)
|
||||
{
|
||||
int len, alen, blen, i, ac, bc;
|
||||
|
||||
@ -1103,12 +1103,6 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b, const int *xcoll_table)
|
||||
ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' ');
|
||||
bc = (unsigned char) ((i < blen) ? b->value.character.string[i] : ' ');
|
||||
|
||||
if (xcoll_table != NULL)
|
||||
{
|
||||
ac = xcoll_table[ac];
|
||||
bc = xcoll_table[bc];
|
||||
}
|
||||
|
||||
if (ac < bc)
|
||||
return -1;
|
||||
if (ac > bc)
|
||||
|
||||
@ -40,7 +40,7 @@ gfc_expr *gfc_constant_result (bt, int, locus *);
|
||||
arith gfc_range_check (gfc_expr *);
|
||||
|
||||
int gfc_compare_expr (gfc_expr *, gfc_expr *);
|
||||
int gfc_compare_string (gfc_expr *, gfc_expr *, const int *);
|
||||
int gfc_compare_string (gfc_expr *, gfc_expr *);
|
||||
|
||||
/* Constant folding for gfc_expr trees. */
|
||||
gfc_expr *gfc_uplus (gfc_expr * op);
|
||||
|
||||
@ -1970,9 +1970,6 @@ gfc_intrinsic_sym *gfc_find_function (const char *);
|
||||
match gfc_intrinsic_func_interface (gfc_expr *, int);
|
||||
match gfc_intrinsic_sub_interface (gfc_code *, int);
|
||||
|
||||
/* simplify.c */
|
||||
void gfc_simplify_init_1 (void);
|
||||
|
||||
/* match.c -- FIXME */
|
||||
void gfc_free_iterator (gfc_iterator *, int);
|
||||
void gfc_free_forall_iterator (gfc_forall_iterator *);
|
||||
|
||||
@ -249,7 +249,6 @@ gfc_init_1 (void)
|
||||
gfc_scanner_init_1 ();
|
||||
gfc_arith_init_1 ();
|
||||
gfc_intrinsic_init_1 ();
|
||||
gfc_simplify_init_1 ();
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -64,31 +64,6 @@ gfc_expr gfc_bad_expr;
|
||||
everything is reasonably straight-forward. The Standard, chapter 13
|
||||
is the best comment you'll find for this file anyway. */
|
||||
|
||||
/* Static table for converting non-ascii character sets to ascii.
|
||||
The xascii_table[] is the inverse table. */
|
||||
|
||||
static int ascii_table[256] = {
|
||||
'\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
|
||||
'\b', '\t', '\n', '\v', '\0', '\r', '\0', '\0',
|
||||
'\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
|
||||
'\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
|
||||
' ', '!', '"', '#', '$', '%', '&', '\'',
|
||||
'(', ')', '*', '+', ',', '-', '.', '/',
|
||||
'0', '1', '2', '3', '4', '5', '6', '7',
|
||||
'8', '9', ':', ';', '<', '=', '>', '?',
|
||||
'@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
|
||||
'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
|
||||
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
|
||||
'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
|
||||
'`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
|
||||
'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
|
||||
'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
|
||||
'x', 'y', 'z', '{', '|', '}', '~', '\?'
|
||||
};
|
||||
|
||||
static int xascii_table[256];
|
||||
|
||||
|
||||
/* Range checks an expression node. If all goes well, returns the
|
||||
node, otherwise returns &gfc_bad_expr and frees the node. */
|
||||
|
||||
@ -266,24 +241,27 @@ gfc_simplify_abs (gfc_expr *e)
|
||||
return result;
|
||||
}
|
||||
|
||||
/* We use the processor's collating sequence, because all
|
||||
sytems that gfortran currently works on are ASCII. */
|
||||
|
||||
gfc_expr *
|
||||
gfc_simplify_achar (gfc_expr *e)
|
||||
{
|
||||
gfc_expr *result;
|
||||
int index;
|
||||
int c;
|
||||
const char *ch;
|
||||
|
||||
if (e->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
/* We cannot assume that the native character set is ASCII in this
|
||||
function. */
|
||||
if (gfc_extract_int (e, &index) != NULL || index < 0 || index > 127)
|
||||
{
|
||||
gfc_error ("Extended ASCII not implemented: argument of ACHAR at %L "
|
||||
"must be between 0 and 127", &e->where);
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
ch = gfc_extract_int (e, &c);
|
||||
|
||||
if (ch != NULL)
|
||||
gfc_internal_error ("gfc_simplify_achar: %s", ch);
|
||||
|
||||
if (gfc_option.warn_surprising && (c < 0 || c > 127))
|
||||
gfc_warning ("Argument of ACHAR function at %L outside of range [0,127]",
|
||||
&e->where);
|
||||
|
||||
result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind,
|
||||
&e->where);
|
||||
@ -291,7 +269,7 @@ gfc_simplify_achar (gfc_expr *e)
|
||||
result->value.character.string = gfc_getmem (2);
|
||||
|
||||
result->value.character.length = 1;
|
||||
result->value.character.string[0] = ascii_table[index];
|
||||
result->value.character.string[0] = c;
|
||||
result->value.character.string[1] = '\0'; /* For debugger */
|
||||
return result;
|
||||
}
|
||||
@ -700,6 +678,7 @@ gfc_simplify_char (gfc_expr *e, gfc_expr *k)
|
||||
{
|
||||
gfc_expr *result;
|
||||
int c, kind;
|
||||
const char *ch;
|
||||
|
||||
kind = get_kind (BT_CHARACTER, k, "CHAR", gfc_default_character_kind);
|
||||
if (kind == -1)
|
||||
@ -708,11 +687,14 @@ gfc_simplify_char (gfc_expr *e, gfc_expr *k)
|
||||
if (e->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
if (gfc_extract_int (e, &c) != NULL || c < 0 || c > UCHAR_MAX)
|
||||
{
|
||||
gfc_error ("Bad character in CHAR function at %L", &e->where);
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
ch = gfc_extract_int (e, &c);
|
||||
|
||||
if (ch != NULL)
|
||||
gfc_internal_error ("gfc_simplify_char: %s", ch);
|
||||
|
||||
if (c < 0 || c > UCHAR_MAX)
|
||||
gfc_error ("Argument of CHAR function at %L outside of range [0,255]",
|
||||
&e->where);
|
||||
|
||||
result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
|
||||
|
||||
@ -1212,6 +1194,8 @@ gfc_simplify_huge (gfc_expr *e)
|
||||
return result;
|
||||
}
|
||||
|
||||
/* We use the processor's collating sequence, because all
|
||||
sytems that gfortran currently works on are ASCII. */
|
||||
|
||||
gfc_expr *
|
||||
gfc_simplify_iachar (gfc_expr *e)
|
||||
@ -1228,7 +1212,11 @@ gfc_simplify_iachar (gfc_expr *e)
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
|
||||
index = xascii_table[(int) e->value.character.string[0] & 0xFF];
|
||||
index = (unsigned char) e->value.character.string[0];
|
||||
|
||||
if (gfc_option.warn_surprising && index > 127)
|
||||
gfc_warning ("Argument of IACHAR function at %L outside of range 0..127",
|
||||
&e->where);
|
||||
|
||||
result = gfc_int_expr (index);
|
||||
result->where = e->where;
|
||||
@ -1409,11 +1397,7 @@ gfc_simplify_ichar (gfc_expr *e)
|
||||
index = (unsigned char) e->value.character.string[0];
|
||||
|
||||
if (index < 0 || index > UCHAR_MAX)
|
||||
{
|
||||
gfc_error ("Argument of ICHAR at %L out of range of this processor",
|
||||
&e->where);
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
gfc_internal_error("Argument of ICHAR at %L out of range", &e->where);
|
||||
|
||||
result = gfc_int_expr (index);
|
||||
result->where = e->where;
|
||||
@ -2126,8 +2110,7 @@ gfc_simplify_lge (gfc_expr *a, gfc_expr *b)
|
||||
if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) >= 0,
|
||||
&a->where);
|
||||
return gfc_logical_expr (gfc_compare_string (a, b) >= 0, &a->where);
|
||||
}
|
||||
|
||||
|
||||
@ -2137,7 +2120,7 @@ gfc_simplify_lgt (gfc_expr *a, gfc_expr *b)
|
||||
if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) > 0,
|
||||
return gfc_logical_expr (gfc_compare_string (a, b) > 0,
|
||||
&a->where);
|
||||
}
|
||||
|
||||
@ -2148,8 +2131,7 @@ gfc_simplify_lle (gfc_expr *a, gfc_expr *b)
|
||||
if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) <= 0,
|
||||
&a->where);
|
||||
return gfc_logical_expr (gfc_compare_string (a, b) <= 0, &a->where);
|
||||
}
|
||||
|
||||
|
||||
@ -2159,8 +2141,7 @@ gfc_simplify_llt (gfc_expr *a, gfc_expr *b)
|
||||
if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
|
||||
return NULL;
|
||||
|
||||
return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) < 0,
|
||||
&a->where);
|
||||
return gfc_logical_expr (gfc_compare_string (a, b) < 0, &a->where);
|
||||
}
|
||||
|
||||
|
||||
@ -4083,27 +4064,3 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
/****************** Helper functions ***********************/
|
||||
|
||||
/* Given a collating table, create the inverse table. */
|
||||
|
||||
static void
|
||||
invert_table (const int *table, int *xtable)
|
||||
{
|
||||
int i;
|
||||
|
||||
for (i = 0; i < 256; i++)
|
||||
xtable[i] = 0;
|
||||
|
||||
for (i = 0; i < 256; i++)
|
||||
xtable[table[i]] = i;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_simplify_init_1 (void)
|
||||
{
|
||||
invert_table (ascii_table, xascii_table);
|
||||
}
|
||||
|
||||
@ -1,3 +1,9 @@
|
||||
2007-01-28 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR libfortran/30389
|
||||
* gfortran.dg/achar_2.f90: New test.
|
||||
* gfortran.dg/achar_3.f90: New test.
|
||||
|
||||
2007-01-27 Ian Lance Taylor <iant@google.com>
|
||||
|
||||
* gcc.dg/strict-overflow-1.c: New test.
|
||||
|
||||
2026
gcc/testsuite/gfortran.dg/achar_2.f90
Normal file
2026
gcc/testsuite/gfortran.dg/achar_2.f90
Normal file
File diff suppressed because it is too large
Load Diff
9
gcc/testsuite/gfortran.dg/achar_3.f90
Normal file
9
gcc/testsuite/gfortran.dg/achar_3.f90
Normal file
@ -0,0 +1,9 @@
|
||||
! { dg-do compile }
|
||||
! { dg-options "-Wall" }
|
||||
program main
|
||||
print *,achar(-3) ! { dg-warning "outside of range" }
|
||||
print *,achar(200) ! { dg-warning "outside of range" }
|
||||
print *,char(222+221) ! { dg-error "outside of range" }
|
||||
print *,char(-44) ! { dg-error "outside of range" }
|
||||
print *,iachar("ü") ! { dg-warning "outside of range" }
|
||||
end program main
|
||||
Loading…
Reference in New Issue
Block a user