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

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

gcc/fortran/ChangeLog

+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.

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,25 +299,25 @@ match_boz_constant (gfc_expr ** result)
   memset (buffer, '\0', length + 1);
 
   match_digits (0, radix, buffer);
-  gfc_next_char ();
+  gfc_next_char ();  /* Eat delimiter.  */
+
+  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, gfc_default_integer_kind, radix,
-			   &gfc_current_locus);
+  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_free_expr (e);
-      return MATCH_ERROR;
-    }
+      gfc_error ("Integer too big for integer kind %i at %C", kind);
 
-  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;
     }

gcc/testsuite/ChangeLog

+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.

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
+
+

gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90

 ! 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