OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

primary.c (match_boz_constant): Allow kind parameter suffixes.

Browse Source 
fortran/
* primary.c (match_boz_constant): Allow kind parameter suffixes.
Move standard warning further to the front.

testsuite/
* gfortran.fortran-torture/execute/intrinsic_mvbits.f90,
gfortran.dg/ishft.f90: Add more tests.

From-SVN: r88690
This commit is contained in:
Tobias Schlüter 2004-10-07 17:12:06 +02:00 committed by Tobias Schlüter
parent 14de86fa0a
commit 5d874166a8
5 changed files with 52 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2004-10-07 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* primary.c (match_boz_constant): Allow kind parameter suffixes.
Move standard warning further to the front.
2004-10-07 Kazu Hirata <kazu@cs.umass.edu>
* trans-stmt.c: Fix a comment typo.

36
gcc/fortran/primary.c
View File

@ -235,7 +235,7 @@ match_integer_constant (gfc_expr ** result, int signflag)
static match
match_boz_constant (gfc_expr ** result)
{
int radix, delim, length, x_hex;
int radix, delim, length, x_hex, kind;
locus old_loc;
char *buffer;
gfc_expr *e;
@ -272,6 +272,12 @@ match_boz_constant (gfc_expr ** result)
if (delim != '\'' && delim != '\"')
goto backup;
if (x_hex && pedantic
&& (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
"constant at %C uses non-standard syntax.")
== FAILURE))
return MATCH_ERROR;
old_loc = gfc_current_locus;
length = match_digits (0, radix, NULL);
@ -293,29 +299,29 @@ match_boz_constant (gfc_expr ** result)
memset (buffer, '\0', length + 1);
match_digits (0, radix, buffer);
gfc_next_char ();
gfc_next_char (); /* Eat delimiter. */
e = gfc_convert_integer (buffer, gfc_default_integer_kind, radix,
&gfc_current_locus);
kind = get_kind ();
if (kind == -1)
return MATCH_ERROR;
if (kind == -2)
kind = gfc_default_integer_kind;
else if (pedantic
&& (gfc_notify_std (GFC_STD_GNU, "Extension: Kind parameter "
"suffix to boz literal constant at %C.")
== FAILURE))
return MATCH_ERROR;
e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
if (gfc_range_check (e) != ARITH_OK)
{
gfc_error ("Integer too big for default integer kind at %C");
gfc_error ("Integer too big for integer kind %i at %C", kind);
gfc_free_expr (e);
return MATCH_ERROR;
}
if (x_hex
&& pedantic
&& (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
"constant at %C uses non-standard syntax.")
== FAILURE))
{
gfc_free_expr (e);
return MATCH_ERROR;
}
*result = e;
return MATCH_YES;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2004-10-07 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.fortran-torture/execute/intrinsic_mvbits.f90,
gfortran.dg/ishft.f90: Add more tests.
2004-10-07 Andrew Pinski <pinskia@physics.uc.edu>
* g++.dg/ext/asm6.C: Remove extraneous semicolon.

17
gcc/testsuite/gfortran.dg/ishft.f90
View File

@ -5,7 +5,7 @@ if (ishft (1_1, 1) /= 2) call abort
if (ishft (3_1, 1) /= 6) call abort
if (ishft (-1_1, 1) /= -2) call abort
if (ishft (-1_1, -1) /= 127) call abort
if (ishft (96_1, 2) /= -128_2) call abort
if (ishft (96_1, 2) /= -128) call abort
if (ishft (1_2, 0) /= 1) call abort
if (ishft (1_2, 1) /= 2) call abort
@ -21,6 +21,12 @@ if (ishft (-1_4, 1) /= -2) call abort
if (ishft (-1_4, -1) /= 2147483647) call abort
if (ishft (1073741824_4 + 536870912_4, 2) /= -2147483648_8) call abort
if (ishft (1_8, 0) /= 1) call abort
if (ishft (1_8, 1) /= 2) call abort
if (ishft (3_8, 1) /= 6) call abort
if (ishft (-1_8, 1) /= -2) call abort
if (ishft (-1_8, -60) /= z'F'_8) call abort
if (ishftc (1_1, 0) /= 1) call abort
if (ishftc (1_1, 1) /= 2) call abort
if (ishftc (3_1, 1) /= 6) call abort
@ -41,4 +47,13 @@ if (ishftc (3_4, 1) /= 6) call abort
if (ishftc (-1_4, 1) /= -1) call abort
if (ishftc (-1_4, -1) /= -1) call abort
if (ishftc (ishftc (1325876_4, 2), -2) /= 1325876) call abort
if (ishftc (1_8, 0) /= 1) call abort
if (ishftc (1_8, 1) /= 2) call abort
if (ishftc (3_8, 1) /= 6) call abort
if (ishftc (-1_8, 1) /= -1) call abort
if (ishftc (-1_8, -1) /= -1) call abort
if (ishftc (ishftc (1325876_8, 2), -2) /= 1325876) call abort
end

5
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90
View File

@ -1,5 +1,6 @@
! Test the MVBITS intrinsic subroutine
INTEGER*4 :: from, to, result
integer*8 :: to8
DATA from / z'0003FFFC' /
DATA to / z'77760000' /
@ -7,4 +8,8 @@ DATA result / z'7777FFFE' /
CALL mvbits(from, 2, 16, to, 1)
if (to /= result) CALL abort()
to8 = 0
call mvbits (b'1011'_8*2_8**32, 33, 3, to8, 2)
if (to8 /= b'10100'_8) call abort
end