diff options
author | Tobias Burnus <burnus@net-b.de> | 2007-12-08 22:46:56 +0100 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-12-08 22:46:56 +0100 |
commit | 00a4618b3f221641d3c617a55bdd2d22f13ae44d (patch) | |
tree | 68c3248c30a91eca167c87f49666a1386e036a1c | |
parent | 1b271c9ba316d536d177249070d510f74a06af3f (diff) | |
download | gcc-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
-rw-r--r-- | gcc/fortran/ChangeLog | 23 | ||||
-rw-r--r-- | gcc/fortran/Make-lang.in | 2 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 24 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
-rw-r--r-- | gcc/fortran/gfortran.texi | 60 | ||||
-rw-r--r-- | gcc/fortran/primary.c | 11 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 20 | ||||
-rw-r--r-- | gcc/fortran/simplify.c | 61 | ||||
-rw-r--r-- | gcc/fortran/target-memory.c | 43 | ||||
-rw-r--r-- | gcc/fortran/target-memory.h | 3 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/boz_10.f90 | 15 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/boz_7.f90 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/boz_8.f90 | 16 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/boz_9.f90 | 118 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/ibits.f90 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr16433.f | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 | 12 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 | 10 |
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 |