diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8a2134fdd87..60cae9b3bc2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2004-10-07 Tobias Schlueter + + * primary.c (match_boz_constant): Allow kind parameter suffixes. + Move standard warning further to the front. + 2004-10-07 Kazu Hirata * trans-stmt.c: Fix a comment typo. diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 45348e6a760..fe6645de21e 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 03e569e4641..9cb3d144913 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-10-07 Tobias Schlueter + + * gfortran.fortran-torture/execute/intrinsic_mvbits.f90, + gfortran.dg/ishft.f90: Add more tests. + 2004-10-07 Andrew Pinski * g++.dg/ext/asm6.C: Remove extraneous semicolon. diff --git a/gcc/testsuite/gfortran.dg/ishft.f90 b/gcc/testsuite/gfortran.dg/ishft.f90 index f3755567175..f7800bd08b8 100644 --- a/gcc/testsuite/gfortran.dg/ishft.f90 +++ b/gcc/testsuite/gfortran.dg/ishft.f90 @@ -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 + + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 index 8aaaf09dd26..086589a1d51 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 @@ -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