OSDN Git Service

2007-12-08 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 8 Dec 2007 21:46:56 +0000 (21:46 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 8 Dec 2007 21:46:56 +0000 (21:46 +0000)
        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.texi (BOZ literal constants): Improve documentation
        and adapt for BOZ changes.
        * Make-lang.ini (resolve.o): Add target-memory.h dependency.
        * gfortran.h (gfc_expr): Add is_boz flag.
        * expr.c: Include target-memory.h.
        (gfc_check_assign): Support transferring BOZ for real/cmlx.
        * resolve.c: Include target-memory.h
        (resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
        * target-memory.c (gfc_convert_boz): New function.
        * target-memory.c (gfc_convert_boz): Add prototype.
        * primary.c (match_boz_constant): Set is_boz, enable F95 error
        also without -pedantic, and allow for Fortran 2003 BOZ.
        (match_real_constant): Fix comment.
        * simplify.c
        * (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
        gfc_simplify_real): Support Fortran 2003 BOZ.

2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.dg/boz_8.f90: New.
        * gfortran.dg/boz_9.f90: New.
        * gfortran.dg/boz_10.f90: New.
        * gfortran.dg/boz_7.f90: Update dg-warning.
        * gfortran.dg/pr16433.f: Add dg-error.
        * gfortan.dg/ibits.f90: Update dg-warning.
        * gfortran.dg/unf_io_convert_1.f90: Update/delete dg-warning.
        * gfortran.dg/unf_io_convert_2.f90: Ditto.

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

19 files changed:
gcc/fortran/ChangeLog
gcc/fortran/Make-lang.in
gcc/fortran/expr.c
gcc/fortran/gfortran.h
gcc/fortran/gfortran.texi
gcc/fortran/primary.c
gcc/fortran/resolve.c
gcc/fortran/simplify.c
gcc/fortran/target-memory.c
gcc/fortran/target-memory.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/boz_10.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/boz_7.f90
gcc/testsuite/gfortran.dg/boz_8.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/boz_9.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ibits.f90
gcc/testsuite/gfortran.dg/pr16433.f
gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
gcc/testsuite/gfortran.dg/unf_io_convert_2.f90

index 25717b1..290005f 100644 (file)
@@ -1,3 +1,26 @@
+2007-12-08  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34342
+       PR fortran/34345
+       PR fortran/18026
+       PR fortran/29471
+
+       * gfortran.texi (BOZ literal constants): Improve documentation
+       and adapt for BOZ changes.
+       * Make-lang.ini (resolve.o): Add target-memory.h dependency.
+       * gfortran.h (gfc_expr): Add is_boz flag.
+       * expr.c: Include target-memory.h.
+       (gfc_check_assign): Support transferring BOZ for real/cmlx.
+       * resolve.c: Include target-memory.h
+       (resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
+       * target-memory.c (gfc_convert_boz): New function.
+       * target-memory.c (gfc_convert_boz): Add prototype.
+       * primary.c (match_boz_constant): Set is_boz, enable F95 error
+       also without -pedantic, and allow for Fortran 2003 BOZ.
+       (match_real_constant): Fix comment.
+       * simplify.c (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
+       gfc_simplify_real): Support Fortran 2003 BOZ.
+
 2007-12-08  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/34359
index 16d4d35..0f5d032 100644 (file)
@@ -324,6 +324,6 @@ fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
   gt-fortran-trans-intrinsic.h
 fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H)
-fortran/resolve.o: fortran/dependency.h fortran/data.h
+fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h
 fortran/data.o: fortran/data.h
 fortran/options.o: $(PARAMS_H) $(TARGET_H)
index e33d97a..1242e5e 100644 (file)
@@ -24,6 +24,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "arith.h"
 #include "match.h"
+#include "target-memory.h" /* for gfc_convert_boz */
 
 /* Get a new expr node.  */
 
@@ -2723,6 +2724,29 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
       && gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS)
     return FAILURE;
 
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
+      && lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L used to "
+                         "initialize non-integer variable '%s'",
+                        &rvalue->where, lvalue->symtree->n.sym->name)
+        == FAILURE)
+    return FAILURE;
+  else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+                        "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+                        &rvalue->where) == FAILURE)
+    return FAILURE;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER)
+    {
+      if (gfc_option.warn_surprising)
+        gfc_warning ("BOZ literal at %L is bitwise transferred "
+                     "non-integer symbol '%s'", &rvalue->where,
+                     lvalue->symtree->n.sym->name);
+      gfc_convert_boz (rvalue, &lvalue->ts);
+    }
+
   if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
     return SUCCESS;
 
index 07dbe92..1045338 100644 (file)
@@ -1430,7 +1430,7 @@ typedef struct gfc_expr
 
   /* True if the expression is a call to a function that returns an array,
      and if we have decided not to allocate temporary data for that array.  */
-  unsigned int inline_noncopying_intrinsic : 1;
+  unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
 
   /* Used to quickly find a given constructor by its offset.  */
   splay_tree con_by_offset;
index 095517d..84795fb 100644 (file)
@@ -862,6 +862,9 @@ Renaming of operators in the @code{USE} statement.
 @cindex ISO C Bindings
 Interoperability with C (ISO C Bindings)
 
+@item
+BOZ as argument of INT, REAL, DBLE and CMPLX.
+
 @end itemize
 
 
@@ -1084,26 +1087,45 @@ of the @code{READ} statement, and the output item lists of the
 @section BOZ literal constants
 @cindex BOZ literal constants
 
+Besides decimal constants, Fortran also supports binary (@code{b}),
+octal (@code{o}) and hexadecimal (@code{z}) integer constants. The
+syntax is: @samp{prefix quote digits quote}, were the prefix is
+either @code{b}, @code{o} or @code{z}, quote is either @code{'} or
+@code{"} and the digits are for binary @code{0} or @code{1}, for
+octal between @code{0} and @code{7}, and for hexadecimal between
+@code{0} and @code{F}. (Example: @code{b'01011101'}.)
+
+Up to Fortran 95, BOZ literals were only allowed to initialize
+integer variables in DATA statements. Since Fortran 2003 BOZ literals
+are also allowed as argument of @code{REAL}, @code{DBLE}, @code{INT}
+and @code{CMPLX}; the result is the same as if the integer BOZ
+literal had been converted by @code{TRANSFER} to, respectively,
+@code{real}, @code{double precision}, @code{integer} or @code{complex}.
+The GNU Fortran intrinsic procedure @code{FLOAT}, @code{DFLOAT},
+@code{COMPLEX} and @code{DCMPLX} are treated alike.
+
 As an extension, GNU Fortran allows hexadecimal BOZ literal constants to
-be specified using the X prefix, in addition to the standard Z prefix.
-BOZ literal constants can also be specified by adding a suffix to the
-string. For example, @code{Z'ABC'} and @code{'ABC'Z} are equivalent.
-
-The Fortran standard restricts the appearance of a BOZ literal constant
-to the @code{DATA} statement, and it is expected to be assigned to an
-@code{INTEGER} variable.  GNU Fortran permits a BOZ literal to appear in
-any initialization expression as well as assignment statements.
-
-Attempts to use a BOZ literal constant to do a bitwise initialization of
-a variable can lead to confusion.  A BOZ literal constant is converted
-to an @code{INTEGER} value with the kind type with the largest decimal
-representation, and this value is then converted numerically to the type
-and kind of the variable in question.  Thus, one should not expect a
-bitwise copy of the BOZ literal constant to be assigned to a @code{REAL}
-variable.
-
-Similarly, initializing an @code{INTEGER} variable with a statement such
-as @code{DATA i/Z'FFFFFFFF'/} will produce an integer overflow rather
+be specified using the @code{X} prefix, in addition to the standard
+@code{Z} prefix. The BOZ literal can also be specified by adding a
+suffix to the string, for example, @code{Z'ABC'} and @code{'ABC'Z} are
+equivalent.
+
+Furthermore, GNU Fortran allows using BOZ literal constants outside
+DATA statements and the four intrinsic functions allowed by Fortran 2003.
+In DATA statements, in direct assignments, where the right-hand side
+only contains a BOZ literal constant, and for old-style initializers of
+the form @code{integer i /o'0173'/}, the constant is transferred
+as if @code{TRANSFER} had been used. In all other cases, the BOZ literal
+constant is converted to an @code{INTEGER} value with
+the largest decimal representation.  This value is then converted
+numerically to the type and kind of the variable in question.
+(For instance @code{real :: r = b'0000001' + 1} initializes @code{r}
+with @code{2.0}.) As different compilers implement the extension
+differently, one should be careful when doing bitwise initialization
+of non-integer variables.
+
+Note that initializing an @code{INTEGER} variable with a statement such
+as @code{DATA i/Z'FFFFFFFF'/} will give an integer overflow error rather
 than the desired result of @math{-1} when @code{i} is a 32-bit integer
 on a system that supports 64-bit integers.  The @samp{-fno-range-check}
 option can be used as a workaround for legacy code that initializes
index 99cdaad..155cfb1 100644 (file)
@@ -349,7 +349,7 @@ match_boz_constant (gfc_expr **result)
   if (delim != '\'' && delim != '\"')
     goto backup;
 
-  if (x_hex && pedantic
+  if (x_hex
       && (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
                          "constant at %C uses non-standard syntax")
          == FAILURE))
@@ -415,6 +415,9 @@ match_boz_constant (gfc_expr **result)
   kind = gfc_max_integer_kind;
   e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
 
+  /* Mark as boz variable.  */
+  e->is_boz = 1;
+
   if (gfc_range_check (e) != ARITH_OK)
     {
       gfc_error ("Integer too big for integer kind %i at %C", kind);
@@ -422,10 +425,8 @@ match_boz_constant (gfc_expr **result)
       return MATCH_ERROR;
     }
 
-  /* FIXME: Fortran 2003 allows BOZ also in REAL(), CMPLX(), INT();
-     see PR18026 and PR29471.  */
   if (!gfc_in_match_data ()
-      && (gfc_notify_std (GFC_STD_GNU, "Extension: BOZ used outside a DATA "
+      && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BOZ used outside a DATA "
                          "statement at %C")
          == FAILURE))
       return MATCH_ERROR;
@@ -440,7 +441,7 @@ backup:
 
 
 /* Match a real constant of some sort.  Allow a signed constant if signflag
-   is nonzero.  Allow integer constants if allow_int is true.  */
+   is nonzero.  */
 
 static match
 match_real_constant (gfc_expr **result, int signflag)
index 5083b9b..c5b95b4 100644 (file)
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "arith.h"  /* For gfc_compare_expr().  */
 #include "dependency.h"
 #include "data.h"
+#include "target-memory.h" /* for gfc_simplify_transfer */
 
 /* Types used in equivalence statements.  */
 
@@ -5885,7 +5886,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   int n;
   gfc_ref *ref;
 
-
   if (gfc_extend_assign (code, ns) == SUCCESS)
     {
       lhs = code->ext.actual->expr;
@@ -5912,6 +5912,24 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   lhs = code->expr;
   rhs = code->expr2;
 
+  if (rhs->is_boz
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+                         "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+                         &code->loc) == FAILURE)
+    return false;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
+    {
+      if (gfc_option.warn_surprising)
+       gfc_warning ("BOZ literal at %L is bitwise transferred "
+                    "non-integer symbol '%s'", &code->loc,
+                    lhs->symtree->n.sym->name);
+
+      gfc_convert_boz (rhs, &lhs->ts);
+    }
+
+
   if (lhs->ts.type == BT_CHARACTER
        && gfc_option.warn_character_truncation)
     {
index 598ec57..ea807d1 100644 (file)
@@ -740,7 +740,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
   switch (x->ts.type)
     {
     case BT_INTEGER:
-      mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
+      if (!x->is_boz)
+       mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
       break;
 
     case BT_REAL:
@@ -761,7 +762,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
       switch (y->ts.type)
        {
        case BT_INTEGER:
-         mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
+         if (!y->is_boz)
+           mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
          break;
 
        case BT_REAL:
@@ -773,6 +775,25 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
        }
     }
 
+  /* Handle BOZ.  */
+  if (x->is_boz)
+    {
+      gfc_typespec ts;
+      ts.kind = result->ts.kind;
+      ts.type = BT_REAL;
+      gfc_convert_boz (x, &ts);
+      mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
+    }
+
+  if (y && y->is_boz)
+    {
+      gfc_typespec ts;
+      ts.kind = result->ts.kind;
+      ts.type = BT_REAL;
+      gfc_convert_boz (y, &ts);
+      mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
+    }
+
   return range_check (result, name);
 }
 
@@ -918,7 +939,8 @@ gfc_simplify_dble (gfc_expr *e)
   switch (e->ts.type)
     {
     case BT_INTEGER:
-      result = gfc_int2real (e, gfc_default_double_kind);
+      if (!e->is_boz)
+       result = gfc_int2real (e, gfc_default_double_kind);
       break;
 
     case BT_REAL:
@@ -933,6 +955,15 @@ gfc_simplify_dble (gfc_expr *e)
       gfc_internal_error ("gfc_simplify_dble(): bad type at %L", &e->where);
     }
 
+  if (e->ts.type == BT_INTEGER && e->is_boz)
+    {
+      gfc_typespec ts;
+      ts.type = BT_REAL;
+      ts.kind = gfc_default_double_kind;
+      result = gfc_copy_expr (e);
+      gfc_convert_boz (result, &ts);
+    }
+
   return range_check (result, "DBLE");
 }
 
@@ -1111,7 +1142,18 @@ gfc_simplify_float (gfc_expr *a)
   if (a->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_int2real (a, gfc_default_real_kind);
+  if (a->is_boz)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_REAL;
+      ts.kind = gfc_default_real_kind;
+
+      result = gfc_copy_expr (a);
+      gfc_convert_boz (result, &ts);
+    }
+  else
+    result = gfc_int2real (a, gfc_default_real_kind);
   return range_check (result, "FLOAT");
 }
 
@@ -2954,7 +2996,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
   switch (e->ts.type)
     {
     case BT_INTEGER:
-      result = gfc_int2real (e, kind);
+      if (!e->is_boz)
+       result = gfc_int2real (e, kind);
       break;
 
     case BT_REAL:
@@ -2970,6 +3013,14 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
       /* Not reached */
     }
 
+  if (e->ts.type == BT_INTEGER && e->is_boz)
+    {
+      gfc_typespec ts;
+      ts.type = BT_REAL;
+      ts.kind = kind;
+      result = gfc_copy_expr (e);
+      gfc_convert_boz (result, &ts);
+    }
   return range_check (result, "REAL");
 }
 
index 3686261..92318e2 100644 (file)
@@ -595,3 +595,46 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
 
   return len;
 }
+
+void
+gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
+{
+  size_t buffer_size;
+  unsigned char *buffer;
+
+  if (!expr->is_boz)
+    return;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT
+             && expr->ts.type == BT_INTEGER);
+
+  /* Don't convert BOZ to logical, character, derived etc.  */
+  if (ts->type == BT_REAL)
+    buffer_size = size_float (ts->kind);
+  else if (ts->type == BT_COMPLEX)
+    buffer_size = size_complex (ts->kind);
+  else
+    return;
+
+  buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
+
+  buffer = (unsigned char*)alloca (buffer_size);
+  encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
+  mpz_clear (expr->value.integer);
+
+  if (ts->type == BT_REAL)
+    {
+      mpfr_init (expr->value.real);
+      gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
+    }
+  else
+    {
+      mpfr_init (expr->value.complex.r);
+      mpfr_init (expr->value.complex.i);
+      gfc_interpret_complex (ts->kind, buffer, buffer_size,
+                            expr->value.complex.r, expr->value.complex.i);
+    }
+  expr->is_boz = 0;  
+  expr->ts.type = ts->type;
+  expr->ts.kind = ts->kind;
+}
index 0bb47dd..ac1ba0a 100644 (file)
@@ -24,6 +24,9 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "gfortran.h"
 
+/* Convert a BOZ to REAL or COMPLEX.  */
+void gfc_convert_boz (gfc_expr *, gfc_typespec *);
+
 /* Return the size of an expression in its target representation.  */
 size_t gfc_target_expr_size (gfc_expr *);
 
index 5cc7830..cbf82bf 100644 (file)
@@ -1,3 +1,19 @@
+2007-12-06  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34342
+       PR fortran/34345
+       PR fortran/18026
+       PR fortran/29471
+
+       * gfortran.dg/boz_8.f90: New.
+       * gfortran.dg/boz_9.f90: New.
+       * gfortran.dg/boz_10.f90: New.
+       * gfortran.dg/boz_7.f90: Update dg-warning.
+       * gfortran.dg/pr16433.f: Add dg-error.
+       * gfortan.dg/ibits.f90: Update dg-warning.
+       * gfortran.dg/unf_io_convert_1.f90: Update/delete dg-warning.
+       * gfortran.dg/unf_io_convert_2.f90: Ditto.
+
 2007-12-08  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/34359
diff --git a/gcc/testsuite/gfortran.dg/boz_10.f90 b/gcc/testsuite/gfortran.dg/boz_10.f90
new file mode 100644 (file)
index 0000000..a88bbde
--- /dev/null
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. And outside DATA statements.
+!
+real :: r
+integer :: i
+r = real(z'FFFF') ! { dg-error "outside a DATA statement" }
+i = int(z'4455')  ! { dg-error "outside a DATA statement" }
+r = z'FFFF' + 1.0 ! { dg-error "outside a DATA statement" }
+i = z'4455' + 1   ! { dg-error "outside a DATA statement" }
+end
index fea0682..348f561 100644 (file)
@@ -6,7 +6,7 @@
 ! Some BOZ extensions where not diagnosed
 !
 integer :: k, m
-integer :: j = z'000abc' ! { dg-error "Extension: BOZ used outside a DATA statement" }
+integer :: j = z'000abc' ! { dg-error "BOZ used outside a DATA statement" }
 data k/x'0003'/ ! { dg-error "uses non-standard syntax" }
 data m/'0003'z/ ! { dg-error "uses non-standard postfix syntax" }
 end
diff --git a/gcc/testsuite/gfortran.dg/boz_8.f90 b/gcc/testsuite/gfortran.dg/boz_8.f90
new file mode 100644 (file)
index 0000000..25e02a8
--- /dev/null
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. Cf. Fortran 2003, 5.2.5 DATA statement:
+! "If a data-stmt-constant is a boz-literal-constant, the
+!  corresponding variable shall be of type integer."
+!
+real :: r
+integer :: i
+data i/z'111'/, r/z'4455'/ ! { dg-error "BOZ literal at .1. used to initialize non-integer variable 'r'" }
+r = z'FFFF' ! { dg-error "outside a DATA statement" }
+i = z'4455' ! { dg-error "outside a DATA statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_9.f90 b/gcc/testsuite/gfortran.dg/boz_9.f90
new file mode 100644 (file)
index 0000000..e9bb79e
--- /dev/null
@@ -0,0 +1,118 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+!
+! PR fortran/34342
+!
+! Test for Fortran 2003 BOZ.
+!
+program f2003
+implicit none
+
+real,parameter             :: r2c = real(int(z'3333'))
+real,parameter             :: rc  = real(z'3333')
+double precision,parameter :: dc  = dble(Z'3FD34413509F79FF')
+complex,parameter          :: z1c = cmplx(b'10101',-4.0)
+complex,parameter          :: z2c = cmplx(5.0, o'01245')
+
+real             :: r2 = real(int(z'3333'))
+real             :: r  = real(z'3333')
+double precision :: d  = dble(Z'3FD34413509F79FF')
+complex          :: z1 = cmplx(b'10101',-4.0)
+complex          :: z2 = cmplx(5.0, o'01245')
+
+if (r2c /= 13107.0) stop '1'
+if (rc  /= 1.83668190E-41) stop '2'
+if (dc /= 0.30102999566398120) stop '3'
+if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
+if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
+
+if (r2 /= 13107.0) stop '1'
+if (r  /= 1.83668190E-41) stop '2'
+if (d /= 0.30102999566398120) stop '3'
+if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
+
+r2 = dble(int(z'3333'))
+r = real(z'3333')
+d = dble(Z'3FD34413509F79FF')
+z1 = cmplx(b'10101',-4.0)
+z2 = cmplx(5.0, o'01245')
+
+if (r2 /= 13107.0) stop '1'
+if (r  /= 1.83668190E-41) stop '2'
+if (d /= 0.30102999566398120) stop '3'
+if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
+
+call test4()
+call test8()
+
+contains
+
+subroutine test4
+real,parameter             :: r2c = real(int(z'3333', kind=4), kind=4)
+real,parameter             :: rc  = real(z'3333', kind=4)
+complex,parameter          :: z1c = cmplx(b'10101',-4.0, kind=4)
+complex,parameter          :: z2c = cmplx(5.0, o'01245', kind=4)
+
+real             :: r2 = real(int(z'3333', kind=4), kind=4)
+real             :: r  = real(z'3333', kind=4)
+complex          :: z1 = cmplx(b'10101',-4.0, kind=4)
+complex          :: z2 = cmplx(5.0, o'01245', kind=4)
+
+if (r2c /= 13107.0) stop '1'
+if (rc  /= 1.83668190E-41) stop '2'
+if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
+if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
+
+if (r2 /= 13107.0) stop '1'
+if (r  /= 1.83668190E-41) stop '2'
+if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
+
+r2 = real(int(z'3333'), kind=4)
+r = real(z'3333', kind=4)
+z1 = cmplx(b'10101',-4.0, kind=4)
+z2 = cmplx(5.0, o'01245', kind=4)
+
+if (r2 /= 13107.0) stop '1'
+if (r  /= 1.83668190E-41) stop '2'
+if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
+end subroutine test4
+
+
+subroutine test8
+real(8),parameter     :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
+real(8),parameter     :: rc  = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
+complex(8),parameter  :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8),parameter  :: z2c = cmplx(5.0, o'444444444442222222222233301245', kind=8)
+
+real(8)             :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+real(8)             :: r  = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
+complex(8)          :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8)          :: z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
+
+if (r2c /= 1099511575347.0d0) stop '1'
+if (rc  /= -3.72356884822177915d-103) stop '2'
+if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) stop '4'
+if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) stop '5'
+
+if (r2 /= 1099511575347.0d0) stop '1'
+if (r  /= -3.72356884822177915d-103) stop '2'
+if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
+
+r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+r  = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
+z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
+
+if (r2 /= 1099511575347.0d0) stop '1'
+if (r  /= -3.72356884822177915d-103) stop '2'
+if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
+if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
+
+end subroutine test8
+
+end program f2003
index 93fe58d..9233b97 100644 (file)
@@ -2,7 +2,7 @@
 ! Test that the mask is properly converted to the kind type of j in ibits.
 program ibits_test
   implicit none
-  integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ used outside a DATA statement" }
+  integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
   integer(8) i,j,k,m
   j = 1
   do i=1,70
index df8c418..cb3dcec 100644 (file)
@@ -1,6 +1,6 @@
 ! { dg-do compile }
       real x
       double precision dx
-      data x/x'2ffde'/ ! { dg-warning "exadecimal constant" "Hex constant can't begin with x" }
+      data x/x'2ffde'/ ! { dg-warning "Hexadecimal constant | used to initialize non-integer" } 
       dx = x  ! { dg-bogus "exadecimal constant" "Hex constant where there is none" }
       end
index bbe02be..3d35312 100644 (file)
@@ -18,9 +18,9 @@ program main
   integer i
   character*4 str
 
-  m(1) = Z'11223344' ! { dg-warning "BOZ used outside a DATA statement" }
-  m(2) = Z'55667788' ! { dg-warning "BOZ used outside a DATA statement" }
-  n    = Z'77AABBCC' ! { dg-warning "BOZ used outside a DATA statement" }
+  m(1) = Z'11223344' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  m(2) = Z'55667788' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  n    = Z'77AABBCC' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
   str = 'asdf'
   do i = 1,size
      r(i) = i
@@ -46,7 +46,7 @@ program main
   read(9) str
   !
   ! check results
-  if (m(1).ne.Z'11223344') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (m(1).ne.Z'11223344') then
      if (debug) then
         print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
      else
@@ -54,7 +54,7 @@ program main
      endif
   endif
   
-  if (m(2).ne.Z'55667788') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (m(2).ne.Z'55667788') then
      if (debug) then
         print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
      else
@@ -62,7 +62,7 @@ program main
      endif
   endif
   
-  if (n.ne.Z'77AABBCC') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (n.ne.Z'77AABBCC') then
      if (debug) then
         print '(A,Z8)','n incorrect.  n = ',n
      else
index bfb3591..f29f6ee 100644 (file)
@@ -15,26 +15,26 @@ program main
   close(10,status="delete")
 
   open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
-  i = (/ Z'11223344', Z'55667700' /) ! { dg-warning "BOZ used outside a DATA statement" }
+  i = (/ Z'11223344', Z'55667700' /)
   write (10) i
   rewind (10)
   read (10) b
-  if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
+  if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) &
     call abort
   backspace 10
   read (10) j
-  if (j /= Z'1122334455667700') call abort ! { dg-warning "BOZ used outside a DATA statement" }
+  if (j /= Z'1122334455667700') call abort
   close (10, status="delete")
 
   open (10, form="unformatted", convert="little_endian") ! { dg-warning "Extension: CONVERT" }
   write (10) i
   rewind (10)
   read (10) b
-  if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
+  if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) &
     call abort
   backspace 10
   read (10) j
-  if (j /= Z'5566770011223344') call abort ! { dg-warning "BOZ used outside a DATA statement" }
+  if (j /= Z'5566770011223344') call abort
   close (10, status="delete")
 
 end program main