aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2007-12-08 22:46:56 +0100
committerTobias Burnus <burnus@gcc.gnu.org>2007-12-08 22:46:56 +0100
commit00a4618b3f221641d3c617a55bdd2d22f13ae44d (patch)
tree68c3248c30a91eca167c87f49666a1386e036a1c /gcc
parent1b271c9ba316d536d177249070d510f74a06af3f (diff)
downloadgcc-00a4618b3f221641d3c617a55bdd2d22f13ae44d.zip
gcc-00a4618b3f221641d3c617a55bdd2d22f13ae44d.tar.gz
gcc-00a4618b3f221641d3c617a55bdd2d22f13ae44d.tar.bz2
re PR fortran/34342 (BOZ extensions not diagnosed as such with -std=f95)
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 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. From-SVN: r130713
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog23
-rw-r--r--gcc/fortran/Make-lang.in2
-rw-r--r--gcc/fortran/expr.c24
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/gfortran.texi60
-rw-r--r--gcc/fortran/primary.c11
-rw-r--r--gcc/fortran/resolve.c20
-rw-r--r--gcc/fortran/simplify.c61
-rw-r--r--gcc/fortran/target-memory.c43
-rw-r--r--gcc/fortran/target-memory.h3
-rw-r--r--gcc/testsuite/ChangeLog16
-rw-r--r--gcc/testsuite/gfortran.dg/boz_10.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/boz_7.f902
-rw-r--r--gcc/testsuite/gfortran.dg/boz_8.f9016
-rw-r--r--gcc/testsuite/gfortran.dg/boz_9.f90118
-rw-r--r--gcc/testsuite/gfortran.dg/ibits.f902
-rw-r--r--gcc/testsuite/gfortran.dg/pr16433.f2
-rw-r--r--gcc/testsuite/gfortran.dg/unf_io_convert_1.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/unf_io_convert_2.f9010
19 files changed, 396 insertions, 46 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 25717b1..290005f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 16d4d35..0f5d032 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -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)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index e33d97a..1242e5e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 07dbe92..1045338 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 095517d..84795fb 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -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
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 99cdaad..155cfb1 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -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)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5083b9b..c5b95b4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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)
{
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 598ec57..ea807d1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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");
}
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 3686261..92318e2 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -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;
+}
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 0bb47dd..ac1ba0a 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -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 *);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5cc7830..cbf82bf 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
index 0000000..a88bbde
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_10.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/boz_7.f90 b/gcc/testsuite/gfortran.dg/boz_7.f90
index fea0682..348f561 100644
--- a/gcc/testsuite/gfortran.dg/boz_7.f90
+++ b/gcc/testsuite/gfortran.dg/boz_7.f90
@@ -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
index 0000000..25e02a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_8.f90
@@ -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
index 0000000..e9bb79e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_9.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/ibits.f90 b/gcc/testsuite/gfortran.dg/ibits.f90
index 93fe58d..9233b97 100644
--- a/gcc/testsuite/gfortran.dg/ibits.f90
+++ b/gcc/testsuite/gfortran.dg/ibits.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/pr16433.f b/gcc/testsuite/gfortran.dg/pr16433.f
index df8c418..cb3dcec 100644
--- a/gcc/testsuite/gfortran.dg/pr16433.f
+++ b/gcc/testsuite/gfortran.dg/pr16433.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
index bbe02be..3d35312 100644
--- a/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
index bfb3591..f29f6ee 100644
--- a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
@@ -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