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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@88690 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8a2134f..60cae9b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.
 2004-10-07  Kazu Hirata  <kazu@cs.umass.edu>
 
        * trans-stmt.c: Fix a comment typo.

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 45348e6..fe6645d 100644 (file)
--- 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)
 {
 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;
   locus old_loc;
   char *buffer;
   gfc_expr *e;


@@ -272,6 +272,12 @@ match_boz_constant (gfc_expr ** result)
   if (delim != '\'' && delim != '\"')
     goto backup;
 
   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);
   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);
   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)
     {
 
   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;
     }
       gfc_free_expr (e);
       return MATCH_ERROR;
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 03e569e..9cb3d14 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
 2004-10-07  Andrew Pinski  <pinskia@physics.uc.edu>
 
        * 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 f375556..f7800bd 100644 (file)
--- 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 (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
 
 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_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
 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_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
 end

+
+

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90
index 8aaaf09..086589a 100644 (file)
--- 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
 ! Test the MVBITS intrinsic subroutine
 INTEGER*4 :: from, to, result

+integer*8 :: to8

 
 DATA from / z'0003FFFC' /
 DATA to / z'77760000' /
 
 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()
 
 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
 end