This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH,fortran] Handle BOZ in accordance to Fortran 2018 standard
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Wed, 17 Jul 2019 20:32:23 -0700
- Subject: [PATCH,fortran] Handle BOZ in accordance to Fortran 2018 standard
- Reply-to: sgk at troutmask dot apl dot washington dot edu
I will be away until Monday. Plenty of time for a review.
TL;DR version:
The attached patch fixes the handling of a BOZ literal constant
in gfortran to conform to the F2018 standard.
Long version:
Highlights:
* No longer need to use -fno-range-check with BOZ
* Fixed merge_bits
* Eliminate a number of undocumented extension.
* Added -fallow-invalid-boz option to allow BOZ in prohibited
contexts. This option is used by the new function gfc_invalid_boz,
which issues an error for an invalid BOZ usage. The option degrades
the error to warning, and may allow the code to compile. The
result may not be what is expected based on older versions of
gfortran (e.g., see FLOAT). The warning can be suppressed with
the -w option.
* Deprecate the use of 'X' for an alias of 'Z'.
* Deprecate postfix syntax (ie., '1234'z).
I believe the patch fixes all open PR's about BOZ with the
possible exception of PR88227. PR88227 is a clever combination
of -m64 and/or -m32 with the -fdefault-* options. It should be
well-known that IHMO the -fdefault-* option should be deprecated.
So, I don't care if this is fixed or not.
There is a long history of poor handling of a BOZ in the Fortran
standard. In revision 95643 (2005-02-27) I made gfortran conform
to the Fortran 95 standard's definition of a BOZ in a DATA statement
(which is the only context in which a BOZ can appear in a conforming
Fortran 95 program). This is tantamount to converting a BOZ to the
widest available INTEGER on a target (i.e., INTEGER(8) or INTEGER(16))
when the BOZ is initially parsed. This has the effect that a BOZ may
appear in any context where a integer literal constant may appear.
Gfortran contains a boat load of undocumented extensions. The patch
removes most of these undocumented extensions (i.e., an error will
be issued).
In F2008 and F2018, a BOZ is a ***typeless*** string of bits, which
does not have a kind type parameter. When the string of bits is to
be converted to some quantity, a few things can happen. If it is
too short, the string is padded with zeros. If it is too long, it
is truncated. The handling of the sign bit is processor dependent.
I have introduced 2 functions in check.c (gfc_boz2int and gfc_boz2real)
to handle the conversion. gfc_boz2int essentially converts a BOZ
into an unsigned integer, and then does two-complements wrap-around
to obtain negative values. gfc_boz2real does the padding/truncation
as needed and then converts that BOZ into an intermediate widest
INTEGER, which is given to gfc_convert_boz in target-memory.c to
do the actual conversion to a REAL. Range checking has been removed
in gfc_convert_boz.
Along the way, I have deprecated the SHORT and LONG aliases for
INT(x,2) and INT(x,4). The primary reason for deprecation is that
LONG is documented to convert its argument to a C long. Well, the
size of a C long depends on the target.
The code for deprecated items is still present and can sometimes
be used via the -fallow-invalid-boz option. After 10.1 is released,
and if I am still contributing to gfortran, I will remove the code.
If someone feels strongly that a previous undocument extension
should be retain, feel free to fix it after I commit the patch.
I think I've weighed the pros and cons, and have made prudent
decision of want to deprecate.
Finally, I will only respond to technical questions/comments.
Any non-technical questions/comments will be forwarded to /dev/null.
2019-07-16 Steven G. Kargl <kargl@gcc.gnu.org>
* arith.c (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
Move to ...
* primary.c (convert_integer, convert_real, convert_complex): ... here.
Rename and make static functions.
(match_integer_constant): Use convert_integer
(match_real_constant): Use convert_real.
(match_complex_constant: Use convert_complex.
* arith.h (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
Remove prototypes.
* array.c (match_array_cons_element): A BOZ cannot be a data
statement value. Jump to a common exit point.
* check.c (gfc_invalid_boz): New function. Emit error or warning
for a BOZ in an invalid context.
(boz_args_check): Move to top of file to prevent need of forward
declaration.
(is_boz_constant): New function. Check that BOZ expr is constant.
(gfc_boz2real): New function. In-place conversion of BOZ literal
constant to REAL in accordance to F2018.
(gfc_boz2int): New function. In-place conversion of BOZ literal
constant to INTEGER in accordance to F2018.
(gfc_check_achar, gfc_check_char, gfc_check_float): Use
gfc_invalid_boz. Convert BOZ as needed.
(gfc_check_bge_bgt_ble_blt): Enforce F2018 requirements on BGE,
BGT, BLE, and BLT intrinsic functions.
(gfc_check_cmplx): Re-organize to check kind, if present, first.
Convert BOZ real and/or imaginary parts as needed in accordance to
F2018.
(gfc_check_complex): Use gfc_invalid_boz. Convert BOZ as needed.
(gfc_check_dcmplx, gfc_check_dble ): Convert BOZ as needed.
(gfc_check_dshift): Make dshift[lr] conform to F2018 standard.
gfc_check_float (gfc_expr *a)
(gfc_check_iand_ieor_ior): Make IAND, IEOR, and IOR conform to
F2018 standard.
(gfc_check_int): Conform to F2018 standard.
(gfc_check_intconv): Deprecate SHORT and LONG aliases for INT2 and
INT. Simply return for a BOZ argument. See gfc_simplify_intconv.
(gfc_check_merge_bits): Make MERGE_BITS conform to Fortran 2018
standard.
(gfc_check_real): Remove incorrect comment. Check kind, if present,
first. Simply return for a BOZ argument. See gfc_simplify_real.
(gfc_check_and): Re-do error handling for BOZ arguments. Remove
special casing ts.type != BT_INTEGER or BT_LOGICAL.
* decl.c (match_old_style_init): Check for BOZ in old-style
initialization. Issue error or warning depending on
-fallow-invalid-boz option. Issue error if variable is not an
INTEGER or REAL and the value is BOZ.
* expr.c (gfc_copy_expr): Copy a BT_BOZ gfc_expr.
(gfc_check_assign): Re-do error handling for a BOZ in an assignment
statement. Do in-place conversion of RHS based on LHS type of
INTEGER or REAL.
* gfortran.h (gfc_expr): Add a boz component. Remove is_boz component.
(gfc_boz2int, gfc_boz2real, gfc_invalid_boz): New prototypes.
* interface.c (gfc_extend_assign): Guard against replacing an
intrinsic involving a BOZ literal constant on RHS.
* invoke.texi: Doument -fallow-invalid-boz.
* lang.opt: New option. -fallow-invalid-boz.
* libgfortran.h (bt): Elevate BOZ to a basic type.
* misc.c (gfc_basic_typename, gfc_typename): Translate BT_BOZ to BOZ.
* primary.c (convert_integer, convert_real, convert_complex): to here.
Rename and make static functions.
* primary.c(match_boz_constant): Rewrite parsing of a BOZ. Re-do
error handling. Deprecate 'X' for hexidecimal and postfix notation.
Use -fallow-invalid-boz and gfc_invalid_boz to accept deprecated code.
* resolve.c (resolve_ordinary_assign): Rework a RHS that is a
BOZ literal constant. Use gfc_invalid_boz to allow previous
nonstandard behavior. Remove range checking of BOZ conversion.
* simplify.c (convert_boz): Remove function.
(simplify_cmplx): Remove conversion of BOZ constants, because
conversion is done in gfc_check_cmplx.
(gfc_simplify_float): Remove conversion of BOZ constant, because
conversion is done in gfc_check_float.
(simplify_intconv): Use gfc_boz2int to convert BOZ to INTEGER.
Remove range checking for BOZ conversion.
(gfc_simplify_real): Use k, if present, to determine kind. Convert
BOZ to REAL. Remove range checking for BOZ conversion.
target-memory.c (gfc_convert_boz): Rewrite to deal with convert of
a BOZ to a REAL value.
2019-07-16 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/achar_5.f90: Fix for new BOZ handling.
* arithmetic_overflow_1.f90: Ditto.
* gfortran.dg/boz_11.f90: Ditto.
* gfortran.dg/boz_12.f90: Ditto.
* gfortran.dg/boz_4.f90: Ditto.
* gfortran.dg/boz_5.f90: Ditto.
* gfortran.dg/boz_6.f90: Ditto.
* gfortran.dg/boz_7.f90: Ditto.
* gfortran.dg/boz_8.f90: Ditto.
* gfortran.dg/dec_structure_6.f90: Ditto.
* gfortran.dg/dec_union_1.f90: Ditto.
* gfortran.dg/dec_union_2.f90: Ditto.
* gfortran.dg/dec_union_5.f90: Ditto.
* gfortran.dg/dshift_3.f90: Ditto.
* gfortran.dg/gnu_logical_2.f90: Ditto.
* gfortran.dg/int_conv_1.f90: Ditto.
* gfortran.dg/ishft_1.f90: Ditto.
* gfortran.dg/nan_4.f90: Ditto.
* gfortran.dg/no_range_check_3.f90: Ditto.
* gfortran.dg/pr16433.f: Ditto.
* gfortran.dg/pr44491.f90: Ditto.
* gfortran.dg/pr58027.f90: Ditto.
* gfortran.dg/pr81509_2.f90: Ditto.
* gfortran.dg/unf_io_convert_1.f90: Ditto.
* gfortran.dg/unf_io_convert_2.f90: Ditto.
* gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90:
Ditto.
* gfortran.fortran-torture/execute/intrinsic_mvbits.f90: Ditto.
* gfortran.fortran-torture/execute/intrinsic_nearest.f90: Ditto.
* gfortran.fortran-torture/execute/seq_io.f90: Ditto.
* gfortran.dg/gnu_logical_1.F: Delete test.
* gfortran.dg/merge_bits_3.f90: New test.
* gfortran.dg/merge_bits_3.f90: Ditto.
* gfortran.dg/boz_int.f90: Ditto.
* gfortran.dg/boz_bge.f90: Ditto.
* gfortran.dg/boz_complex_1.f90: Ditto.
* gfortran.dg/boz_complex_2.f90: Ditto.
* gfortran.dg/boz_complex_3.f90: Ditto.
* gfortran.dg/boz_dble.f90: Ditto.
* gfortran.dg/boz_dshift_1.f90: Ditto.
* gfortran.dg/boz_dshift_2.f90: Ditto.
* gfortran.dg/boz_float_1.f90: Ditto.
* gfortran.dg/boz_float_2.f90: Ditto.
* gfortran.dg/boz_float_3.f90: Ditto.
* gfortran.dg/boz_iand_1.f90: Ditto.
* gfortran.dg/boz_iand_2.f90: Ditto.
Bootstrapped on i585-*-freebsd and x86_64-*-freebsd. No regressions
after fixing all the nonstandard code in the testsuite. :-)
Ok to commit?
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
Index: gcc/fortran/arith.c
===================================================================
--- gcc/fortran/arith.c (revision 273541)
+++ gcc/fortran/arith.c (working copy)
@@ -1892,56 +1892,6 @@ gfc_le (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op
}
-/* Convert an integer string to an expression node. */
-
-gfc_expr *
-gfc_convert_integer (const char *buffer, int kind, int radix, locus *where)
-{
- gfc_expr *e;
- const char *t;
-
- e = gfc_get_constant_expr (BT_INTEGER, kind, where);
- /* A leading plus is allowed, but not by mpz_set_str. */
- if (buffer[0] == '+')
- t = buffer + 1;
- else
- t = buffer;
- mpz_set_str (e->value.integer, t, radix);
-
- return e;
-}
-
-
-/* Convert a real string to an expression node. */
-
-gfc_expr *
-gfc_convert_real (const char *buffer, int kind, locus *where)
-{
- gfc_expr *e;
-
- e = gfc_get_constant_expr (BT_REAL, kind, where);
- mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
-
- return e;
-}
-
-
-/* Convert a pair of real, constant expression nodes to a single
- complex expression node. */
-
-gfc_expr *
-gfc_convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
-{
- gfc_expr *e;
-
- e = gfc_get_constant_expr (BT_COMPLEX, kind, &real->where);
- mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
- GFC_MPC_RND_MODE);
-
- return e;
-}
-
-
/******* Simplification of intrinsic functions with constant arguments *****/
Index: gcc/fortran/arith.h
===================================================================
--- gcc/fortran/arith.h (revision 273541)
+++ gcc/fortran/arith.h (working copy)
@@ -59,11 +59,6 @@ gfc_expr *gfc_ge (gfc_expr *, gfc_expr *, gfc_intrinsi
gfc_expr *gfc_lt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
gfc_expr *gfc_le (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
-/* Convert strings to literal constants. */
-gfc_expr *gfc_convert_integer (const char *, int, int, locus *);
-gfc_expr *gfc_convert_real (const char *, int, locus *);
-gfc_expr *gfc_convert_complex (gfc_expr *, gfc_expr *, int);
-
/* Convert a constant of one kind to another kind. */
gfc_expr *gfc_int2int (gfc_expr *, int);
gfc_expr *gfc_int2real (gfc_expr *, int);
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 273541)
+++ gcc/fortran/array.c (working copy)
@@ -1110,17 +1110,27 @@ match_array_cons_element (gfc_constructor_base *result
if (m != MATCH_YES)
return m;
+ if (expr->ts.type == BT_BOZ)
+ {
+ gfc_error ("BOZ literal constant at %L cannot appear in an "
+ "array constructor", &expr->where);
+ goto done;
+ }
+
if (expr->expr_type == EXPR_FUNCTION
&& expr->ts.type == BT_UNKNOWN
&& strcmp(expr->symtree->name, "null") == 0)
- {
+ {
gfc_error ("NULL() at %C cannot appear in an array constructor");
- gfc_free_expr (expr);
- return MATCH_ERROR;
- }
+ goto done;
+ }
gfc_constructor_append_expr (result, expr, &gfc_current_locus);
return MATCH_YES;
+
+done:
+ gfc_free_expr (expr);
+ return MATCH_ERROR;
}
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 273541)
+++ gcc/fortran/check.c (working copy)
@@ -34,7 +34,226 @@ along with GCC; see the file COPYING3. If not see
#include "constructor.h"
#include "target-memory.h"
+/* A BOZ literal constant can appear in a limited number of contexts.
+ gfc_invalid_boz() is a help function to simplify error/warning generation.
+ Note, gfortran accepts the nonstandard 'X' for 'Z' the nonstandard
+ suffix location. If -fallow-invalid-boz is used, then issue a warning;
+ otherwise issue an error. */
+bool
+gfc_invalid_boz (const char *msg, locus *loc)
+{
+ if (flag_allow_invalid_boz)
+ {
+ gfc_warning (0, msg, loc);
+ return false;
+ }
+
+ gfc_error (msg, loc);
+ return true;
+}
+
+
+/* Some precedures take two arguments such that both cannot be BOZ. */
+
+static bool
+boz_args_check(gfc_expr *i, gfc_expr *j)
+{
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_BOZ)
+ {
+ gfc_error ("Arguments of %qs at %L and %L cannot both be BOZ "
+ "literal constants", gfc_current_intrinsic, &i->where,
+ &j->where);
+ return false;
+
+ }
+
+ return true;
+}
+
+
+/* Check that a BOZ is a constant. */
+
+static bool
+is_boz_constant (gfc_expr *a)
+{
+ if (a->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("Invalid use of BOZ literal constant at %L", &a->where);
+ return false;
+ }
+
+ return true;
+}
+
+
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real ()
+ converts the string into a REAL of the appropriate kind. The treatment
+ of the sign bit is processor dependent. */
+
+bool
+gfc_boz2real (gfc_expr *x, int kind)
+{
+ extern int gfc_max_integer_kind;
+ gfc_typespec ts;
+ int len;
+ char *buf, *str;
+
+ if (!is_boz_constant (x))
+ return false;
+
+ /* Determine the length of the required string. */
+ len = 8 * kind;
+ if (x->boz.rdx == 16) len /= 4;
+ if (x->boz.rdx == 8) len = len / 3 + 1;
+ buf = (char *) alloca (len + 1); /* +1 for NULL terminator. */
+
+ if (x->boz.len >= len) /* Truncate if necessary. */
+ {
+ str = x->boz.str + (x->boz.len - len);
+ strcpy(buf, str);
+ }
+ else /* Copy and pad. */
+ {
+ memset (buf, 48, len);
+ str = buf + (len - x->boz.len);
+ strcpy (str, x->boz.str);
+ }
+
+ /* Need to adjust leading bits in an octal string. */
+ if (x->boz.rdx == 8)
+ {
+ /* Clear first bit. */
+ if (kind == 4 || kind == 10 || kind == 16)
+ {
+ if (buf[0] == '4')
+ buf[0] = '0';
+ else if (buf[0] == '5')
+ buf[0] = '1';
+ else if (buf[0] == '6')
+ buf[0] = '2';
+ else if (buf[0] == '7')
+ buf[0] = '3';
+ }
+ /* Clear first two bits. */
+ else
+ {
+ if (buf[0] == '4' || buf[0] == '6')
+ buf[0] = '0';
+ else if (buf[0] == '5' || buf[0] == '7')
+ buf[0] = '1';
+ }
+ }
+
+ /* Reset BOZ string to the truncated or padded version. */
+ free (x->boz.str);
+ x->boz.len = len;
+ x->boz.str = XCNEWVEC (char, len + 1);
+ strncpy (x->boz.str, buf, len);
+
+ /* Convert to widest possible integer. */
+ gfc_boz2int (x, gfc_max_integer_kind);
+ ts.type = BT_REAL;
+ ts.kind = kind;
+ if (!gfc_convert_boz (x, &ts))
+ {
+ gfc_error ("Failure in conversion of BOZ to REAL at %L", &x->where);
+ return false;
+ }
+
+ return true;
+}
+
+
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2int ()
+ converts the string into an INTEGER of the appropriate kind. The
+ treatment of the sign bit is processor dependent. If the converted
+ value exceeds the range of the type, then wrap-around semantics are
+ applied. */
+
+bool
+gfc_boz2int (gfc_expr *x, int kind)
+{
+ int i, len;
+ char *buf, *str;
+ mpz_t tmp1;
+
+ if (!is_boz_constant (x))
+ return false;
+
+ i = gfc_validate_kind (BT_INTEGER, kind, false);
+ len = gfc_integer_kinds[i].bit_size;
+ if (x->boz.rdx == 16) len /= 4;
+ if (x->boz.rdx == 8) len = len / 3 + 1;
+ buf = (char *) alloca (len + 1); /* +1 for NULL terminator. */
+
+ if (x->boz.len >= len) /* Truncate if necessary. */
+ {
+ str = x->boz.str + (x->boz.len - len);
+ strcpy(buf, str);
+ }
+ else /* Copy and pad. */
+ {
+ memset (buf, 48, len);
+ str = buf + (len - x->boz.len);
+ strcpy (str, x->boz.str);
+ }
+
+ /* Need to adjust leading bits in an octal string. */
+ if (x->boz.rdx == 8)
+ {
+ /* Clear first bit. */
+ if (kind == 1 || kind == 4 || kind == 16)
+ {
+ if (buf[0] == '4')
+ buf[0] = '0';
+ else if (buf[0] == '5')
+ buf[0] = '1';
+ else if (buf[0] == '6')
+ buf[0] = '2';
+ else if (buf[0] == '7')
+ buf[0] = '3';
+ }
+ /* Clear first two bits. */
+ else
+ {
+ if (buf[0] == '4' || buf[0] == '6')
+ buf[0] = '0';
+ else if (buf[0] == '5' || buf[0] == '7')
+ buf[0] = '1';
+ }
+ }
+
+ /* Convert as-if unsigned integer. */
+ mpz_init (tmp1);
+ mpz_set_str (tmp1, buf, x->boz.rdx);
+
+ /* Check for wrap-around. */
+ if (mpz_cmp (tmp1, gfc_integer_kinds[i].huge) > 0)
+ {
+ mpz_t tmp2;
+ mpz_init (tmp2);
+ mpz_add_ui (tmp2, gfc_integer_kinds[i].huge, 1);
+ mpz_mod (tmp1, tmp1, tmp2);
+ mpz_sub (tmp1, tmp1, tmp2);
+ mpz_clear (tmp2);
+ }
+
+ /* Clear boz info. */
+ x->boz.rdx = 0;
+ x->boz.len = 0;
+ free (x->boz.str);
+
+ mpz_init (x->value.integer);
+ mpz_set (x->value.integer, tmp1);
+ x->ts.type = BT_INTEGER;
+ x->ts.kind = kind;
+ mpz_clear (tmp1);
+
+ return true;
+}
+
+
/* Make sure an expression is a scalar. */
static bool
@@ -880,8 +1099,19 @@ gfc_check_abs (gfc_expr *a)
bool
gfc_check_achar (gfc_expr *a, gfc_expr *kind)
{
+ if (a->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
+ "ACHAR intrinsic subprogram", &a->where))
+ return false;
+
+ if (!gfc_boz2int (a, gfc_default_integer_kind))
+ return false;
+ }
+
if (!type_check (a, 0, BT_INTEGER))
return false;
+
if (!kind_check (kind, 1, BT_CHARACTER))
return false;
@@ -1471,6 +1701,27 @@ gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_e
bool
gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
{
+ extern int gfc_max_integer_kind;
+
+ /* If i and j are both BOZ, convert to widest INTEGER. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_BOZ)
+ {
+ if (!gfc_boz2int (i, gfc_max_integer_kind))
+ return false;
+ if (!gfc_boz2int (j, gfc_max_integer_kind))
+ return false;
+ }
+
+ /* If i is BOZ and j is integer, convert i to type of j. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+ && !gfc_boz2int (i, j->ts.kind))
+ return false;
+
+ /* If j is BOZ and i is integer, convert j to type of i. */
+ if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+ && !gfc_boz2int (j, i->ts.kind))
+ return false;
+
if (!type_check (i, 0, BT_INTEGER))
return false;
@@ -1503,8 +1754,19 @@ gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
bool
gfc_check_char (gfc_expr *i, gfc_expr *kind)
{
+ if (i->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
+ "CHAR intrinsic subprogram", &i->where))
+ return false;
+
+ if (!gfc_boz2int (i, gfc_default_integer_kind))
+ return false;
+ }
+
if (!type_check (i, 0, BT_INTEGER))
return false;
+
if (!kind_check (kind, 1, BT_CHARACTER))
return false;
@@ -1590,11 +1852,29 @@ gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, g
bool
gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
{
+ int k;
+
+ /* Check kind first, because it may be needed in conversion of a BOZ. */
+ if (kind)
+ {
+ if (!kind_check (kind, 2, BT_COMPLEX))
+ return false;
+ gfc_extract_int (kind, &k);
+ }
+ else
+ k = gfc_default_complex_kind;
+
+ if (x->ts.type == BT_BOZ && !gfc_boz2real (x, k))
+ return false;
+
if (!numeric_check (x, 0))
return false;
if (y != NULL)
{
+ if (y->ts.type == BT_BOZ && !gfc_boz2real (y, k))
+ return false;
+
if (!numeric_check (y, 1))
return false;
@@ -1615,12 +1895,8 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *k
&y->where);
return false;
}
-
}
- if (!kind_check (kind, 2, BT_COMPLEX))
- return false;
-
if (!kind && warn_conversion
&& x->ts.type == BT_REAL && x->ts.kind > gfc_default_real_kind)
gfc_warning_now (OPT_Wconversion, "Conversion from %s to default-kind "
@@ -1926,6 +2202,33 @@ gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image,
bool
gfc_check_complex (gfc_expr *x, gfc_expr *y)
{
+
+ /* FIXME BOZ. What to do with complex? */
+ if (!boz_args_check (x, y))
+ return false;
+
+ if (x->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
+ "intrinsic subprogram", &x->where))
+ return false;
+ if (y->ts.type == BT_INTEGER && !gfc_boz2int (x, y->ts.kind))
+ return false;
+ if (y->ts.type == BT_REAL && !gfc_boz2real (x, y->ts.kind))
+ return false;
+ }
+
+ if (y->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
+ "intrinsic subprogram", &y->where))
+ return false;
+ if (x->ts.type == BT_INTEGER && !gfc_boz2int (y, x->ts.kind))
+ return false;
+ if (x->ts.type == BT_REAL && !gfc_boz2real (y, x->ts.kind))
+ return false;
+ }
+
if (!int_or_real_check (x, 0))
return false;
if (!scalar_check (x, 0))
@@ -2047,11 +2350,17 @@ bool gfc_check_datan2 (gfc_expr *y, gfc_expr *x)
bool
gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
{
+ if (x->ts.type == BT_BOZ && !gfc_boz2real (x, gfc_default_double_kind))
+ return false;
+
if (!numeric_check (x, 0))
return false;
if (y != NULL)
{
+ if (y->ts.type == BT_BOZ && !gfc_boz2real (y, gfc_default_double_kind))
+ return false;
+
if (!numeric_check (y, 1))
return false;
@@ -2081,6 +2390,9 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
bool
gfc_check_dble (gfc_expr *x)
{
+ if (x->ts.type == BT_BOZ && !gfc_boz2real (x, gfc_default_double_kind))
+ return false;
+
if (!numeric_check (x, 0))
return false;
@@ -2167,55 +2479,40 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
return true;
}
-
-static bool
-boz_args_check(gfc_expr *i, gfc_expr *j)
+bool
+gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
{
- if (i->is_boz && j->is_boz)
- {
- gfc_error ("Arguments of %qs at %L and %L cannot both be BOZ "
- "literal constants", gfc_current_intrinsic, &i->where,
- &j->where);
- return false;
+ /* i and j cannot both be BOZ literal constants. */
+ if (!boz_args_check (i, j))
+ return false;
- }
- return true;
-}
+ /* If i is BOZ and j is integer, convert i to type of j. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+ && !gfc_boz2int (i, j->ts.kind))
+ return false;
+ /* If j is BOZ and i is integer, convert j to type of i. */
+ if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+ && !gfc_boz2int (j, i->ts.kind))
+ return false;
-bool
-gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
-{
if (!type_check (i, 0, BT_INTEGER))
return false;
if (!type_check (j, 1, BT_INTEGER))
return false;
- if (!boz_args_check (i, j))
+ if (!same_type_check (i, 0, j, 1))
return false;
- if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1))
- return false;
-
if (!type_check (shift, 2, BT_INTEGER))
return false;
if (!nonnegative_check ("SHIFT", shift))
return false;
- if (i->is_boz)
- {
- if (!less_than_bitsize1 ("J", j, "SHIFT", shift, true))
- return false;
- i->ts.kind = j->ts.kind;
- }
- else
- {
- if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true))
- return false;
- j->ts.kind = i->ts.kind;
- }
+ if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true))
+ return false;
return true;
}
@@ -2367,9 +2664,19 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, g
return true;
}
+
bool
gfc_check_float (gfc_expr *a)
{
+ if (a->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in the "
+ "FLOAT intrinsic subprogram", &a->where))
+ return false;
+ if (!gfc_boz2int (a, gfc_default_integer_kind))
+ return false;
+ }
+
if (!type_check (a, 0, BT_INTEGER))
return false;
@@ -2495,18 +2802,26 @@ gfc_check_i (gfc_expr *i)
bool
gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
{
- if (!type_check (i, 0, BT_INTEGER))
+ /* i and j cannot both be BOZ literal constants. */
+ if (!boz_args_check (i, j))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ /* If i is BOZ and j is integer, convert i to type of j. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+ && !gfc_boz2int (i, j->ts.kind))
return false;
- if (!boz_args_check (i, j))
+ /* If j is BOZ and i is integer, convert j to type of i. */
+ if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+ && !gfc_boz2int (j, i->ts.kind))
return false;
- if (i->is_boz) i->ts.kind = j->ts.kind;
- if (j->is_boz) j->ts.kind = i->ts.kind;
+ if (!type_check (i, 0, BT_INTEGER))
+ return false;
+ if (!type_check (j, 1, BT_INTEGER))
+ return false;
+
if (i->ts.kind != j->ts.kind)
{
gfc_error ("Arguments of %qs have different kind type parameters "
@@ -2658,6 +2973,10 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring
bool
gfc_check_int (gfc_expr *x, gfc_expr *kind)
{
+ /* BOZ is dealt within simplify_int*. */
+ if (x->ts.type == BT_BOZ)
+ return true;
+
if (!numeric_check (x, 0))
return false;
@@ -2671,6 +2990,19 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
bool
gfc_check_intconv (gfc_expr *x)
{
+ if (strcmp (gfc_current_intrinsic, "short") == 0
+ || strcmp (gfc_current_intrinsic, "long") == 0)
+ {
+ gfc_error ("%qs intrinsic subprogram at %L has been deprecated. "
+ "Use INT intrinsic subprogram.", gfc_current_intrinsic,
+ &x->where);
+ return false;
+ }
+
+ /* BOZ is dealt within simplify_int*. */
+ if (x->ts.type == BT_BOZ)
+ return true;
+
if (!numeric_check (x, 0))
return false;
@@ -3554,29 +3886,38 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource,
bool
gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask)
{
- if (!type_check (i, 0, BT_INTEGER))
+ /* i and j cannot both be BOZ literal constants. */
+ if (!boz_args_check (i, j))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ /* If i is BOZ and j is integer, convert i to type of j. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+ && !gfc_boz2int (i, j->ts.kind))
return false;
- if (!boz_args_check (i, j))
+ /* If j is BOZ and i is integer, convert j to type of i. */
+ if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+ && !gfc_boz2int (j, i->ts.kind))
return false;
- if (i->is_boz) i->ts.kind = j->ts.kind;
- if (j->is_boz) j->ts.kind = i->ts.kind;
+ if (!type_check (i, 0, BT_INTEGER))
+ return false;
- if (!type_check (mask, 2, BT_INTEGER))
+ if (!type_check (j, 1, BT_INTEGER))
return false;
if (!same_type_check (i, 0, j, 1))
return false;
- if (!same_type_check (i, 0, mask, 2))
+ if (mask->ts.type == BT_BOZ && !gfc_boz2int(mask, i->ts.kind))
return false;
- if (mask->is_boz) mask->ts.kind = i->ts.kind;
+ if (!type_check (mask, 2, BT_INTEGER))
+ return false;
+ if (!same_type_check (i, 0, mask, 2))
+ return false;
+
return true;
}
@@ -3977,14 +4318,17 @@ gfc_check_rank (gfc_expr *a)
}
-/* real, float, sngl. */
bool
gfc_check_real (gfc_expr *a, gfc_expr *kind)
{
- if (!numeric_check (a, 0))
+ if (!kind_check (kind, 1, BT_REAL))
return false;
- if (!kind_check (kind, 1, BT_REAL))
+ /* BOZ is dealt with in gfc_simplify_real. */
+ if (a->ts.type == BT_BOZ)
+ return true;
+
+ if (!numeric_check (a, 0))
return false;
return true;
@@ -6726,42 +7070,28 @@ gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
bool
gfc_check_and (gfc_expr *i, gfc_expr *j)
{
- if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
- {
- gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
- "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
- gfc_current_intrinsic, &i->where);
- return false;
- }
+ /* i and j cannot both be BOZ literal constants. */
+ if (!boz_args_check (i, j))
+ return false;
- if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
- {
- gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
- "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
- gfc_current_intrinsic, &j->where);
- return false;
- }
+ /* If i is BOZ and j is integer, convert i to type of j. */
+ if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+ && !gfc_boz2int (i, j->ts.kind))
+ return false;
- if (i->ts.type != j->ts.type)
- {
- gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
- "have the same type", gfc_current_intrinsic_arg[0]->name,
- gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
- &j->where);
- return false;
- }
-
- if (!scalar_check (i, 0))
+ /* If j is BOZ and i is integer, convert j to type of i. */
+ if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+ && !gfc_boz2int (j, i->ts.kind))
return false;
- if (!scalar_check (j, 1))
+ if (!same_type_check (i, 0, j, 1, false))
return false;
- if (!boz_args_check (i, j))
+ if (!scalar_check (i, 0))
return false;
- if (i->is_boz) i->ts.kind = j->ts.kind;
- if (j->is_boz) j->ts.kind = i->ts.kind;
+ if (!scalar_check (j, 1))
+ return false;
return true;
}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 273541)
+++ gcc/fortran/decl.c (working copy)
@@ -547,7 +547,7 @@ match_old_style_init (const char *name)
match m;
gfc_symtree *st;
gfc_symbol *sym;
- gfc_data *newdata;
+ gfc_data *newdata, *nd;
/* Set up data structure to hold initializers. */
gfc_find_sym_tree (name, NULL, 0, &st);
@@ -565,6 +565,25 @@ match_old_style_init (const char *name)
{
free (newdata);
return m;
+ }
+
+ /* Check that a BOZ did not creep into an old-style initialization. */
+ for (nd = newdata; nd; nd = nd->next)
+ {
+ if (nd->value->expr->ts.type == BT_BOZ
+ && gfc_invalid_boz ("BOZ at %L cannot appear in an old-style "
+ "initialization", &nd->value->expr->where))
+ return MATCH_ERROR;
+
+ if (nd->var->expr->ts.type != BT_INTEGER
+ && nd->var->expr->ts.type != BT_REAL
+ && nd->value->expr->ts.type == BT_BOZ)
+ {
+ gfc_error ("Mismatch in variable type and BOZ literal constant "
+ "at %L in an old-style initialization",
+ &nd->value->expr->where);
+ return MATCH_ERROR;
+ }
}
if (gfc_pure (NULL))
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 273541)
+++ gcc/fortran/expr.c (working copy)
@@ -342,6 +342,13 @@ gfc_copy_expr (gfc_expr *p)
case BT_ASSUMED:
break; /* Already done. */
+ case BT_BOZ:
+ q->boz.len = p->boz.len;
+ q->boz.rdx = p->boz.rdx;
+ q->boz.str = XCNEWVEC (char, q->boz.len + 1);
+ strncpy (q->boz.str, p->boz.str, p->boz.len);
+ break;
+
case BT_PROCEDURE:
case BT_VOID:
/* Should never be reached. */
@@ -3634,45 +3641,30 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue,
&& !gfc_check_conformance (lvalue, rvalue, "array assignment"))
return false;
- if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
+ if (rvalue->ts.type == BT_BOZ && lvalue->ts.type != BT_INTEGER
&& lvalue->symtree->n.sym->attr.data
&& !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
"initialize non-integer variable %qs",
&rvalue->where, lvalue->symtree->n.sym->name))
return false;
- else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
+ else if (rvalue->ts.type == BT_BOZ && !lvalue->symtree->n.sym->attr.data
&& !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
&rvalue->where))
return false;
/* Handle the case of a BOZ literal on the RHS. */
- if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER)
+ if (rvalue->ts.type == BT_BOZ)
{
- int rc;
- if (warn_surprising)
- gfc_warning (OPT_Wsurprising,
- "BOZ literal at %L is bitwise transferred "
- "non-integer symbol %qs", &rvalue->where,
- lvalue->symtree->n.sym->name);
- if (!gfc_convert_boz (rvalue, &lvalue->ts))
- return false;
- if ((rc = gfc_range_check (rvalue)) != ARITH_OK)
- {
- if (rc == ARITH_UNDERFLOW)
- gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rvalue->where);
- else if (rc == ARITH_OVERFLOW)
- gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rvalue->where);
- else if (rc == ARITH_NAN)
- gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rvalue->where);
- return false;
- }
+ /* FIXME BOZ. Need gfc_invalid_boz() here?. */
+ if (lvalue->ts.type == BT_INTEGER
+ && gfc_boz2int (rvalue, lvalue->ts.kind))
+ return true;
+ if (lvalue->ts.type == BT_REAL
+ && gfc_boz2real (rvalue, lvalue->ts.kind))
+ return true;
+
+ return false;
}
if (gfc_expr_attr (lvalue).pdt_kind || gfc_expr_attr (lvalue).pdt_len)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 273541)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2152,9 +2152,8 @@ typedef struct gfc_expr
is not a variable. */
struct gfc_expr *base_expr;
- /* is_boz is true if the integer is regarded as BOZ bit pattern and is_snan
- denotes a signalling not-a-number. */
- unsigned int is_boz : 1, is_snan : 1;
+ /* is_snan denotes a signalling not-a-number. */
+ unsigned int is_snan : 1;
/* Sometimes, when an error has been emitted, it is necessary to prevent
it from recurring. */
@@ -2198,6 +2197,14 @@ typedef struct gfc_expr
}
representation;
+ struct
+ {
+ int len; /* Length of BOZ string without terminating NULL. */
+ int rdx; /* Radix of BOZ. */
+ char *str; /* BOZ string with NULL terminating character. */
+ }
+ boz;
+
union
{
int logical;
@@ -3479,6 +3486,10 @@ bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t
bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
size_t*, size_t*, size_t*);
+bool gfc_boz2int (gfc_expr *, int);
+bool gfc_boz2real (gfc_expr *, int);
+bool gfc_invalid_boz (const char *, locus *);
+
/* class.c */
void gfc_fix_class_refs (gfc_expr *e);
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 273541)
+++ gcc/fortran/interface.c (working copy)
@@ -4274,6 +4274,12 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
lhs = c->expr1;
rhs = c->expr2;
+ /* Don't allow an intrinsic assignment with a BOZ rhs to be replaced. */
+ if (c->op == EXEC_ASSIGN
+ && c->expr1->expr_type == EXPR_VARIABLE
+ && c->expr2->expr_type == EXPR_CONSTANT && c->expr2->ts.type == BT_BOZ)
+ return false;
+
/* Don't allow an intrinsic assignment to be replaced. */
if (lhs->ts.type != BT_DERIVED && lhs->ts.type != BT_CLASS
&& (rhs->rank == 0 || rhs->rank == lhs->rank)
Index: gcc/fortran/invoke.texi
===================================================================
--- gcc/fortran/invoke.texi (revision 273541)
+++ gcc/fortran/invoke.texi (working copy)
@@ -116,13 +116,13 @@ by type. Explanations are in the following sections.
@table @emph
@item Fortran Language Options
@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
-@gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
--fd-lines-as-comments -fdec -fdec-structure -fdec-intrinsic-ints @gol
--fdec-static -fdec-math -fdec-include -fdec-format-defaults @gol
--fdec-blank-format-item -fdefault-double-8 -fdefault-integer-8 @gol
--fdefault-real-8 -fdefault-real-10 -fdefault-real-16 -fdollar-ok @gol
--ffixed-line-length-@var{n} -ffixed-line-length-none -fpad-source @gol
--ffree-form -ffree-line-length-@var{n} -ffree-line-length-none @gol
+@gccoptlist{-fall-intrinsics -fallow-invalid-boz -fbackslash -fcray-pointer @gol
+-fd-lines-as-code -fd-lines-as-comments -fdec -fdec-structure @gol
+-fdec-intrinsic-ints -fdec-static -fdec-math -fdec-include @gol
+-fdec-format-defaults -fdec-blank-format-item -fdefault-double-8 @gol
+-fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 -fdefault-real-16 @gol
+-fdollar-ok @gol -ffixed-line-length-@var{n} -ffixed-line-length-none @gol
+-fpad-source -ffree-form -ffree-line-length-@var{n} -ffree-line-length-none @gol
-fimplicit-none -finteger-4-integer-8 -fmax-identifier-length @gol
-fmodule-private -ffixed-form -fno-range-check -fopenacc -fopenmp @gol
-freal-4-real-10 -freal-4-real-16 -freal-4-real-8 -freal-8-real-10 @gol
@@ -230,6 +230,13 @@ force standard-compliance but get access to the full r
available with @command{gfortran}. As a consequence, @option{-Wintrinsics-std}
will be ignored and no user-defined procedure with the same name as any
intrinsic will be called except when it is explicitly declared @code{EXTERNAL}.
+
+@item -fallow-invalid-boz
+@opindex @code{allow-invalid-boz}
+A BOZ literal constant can occur in a limited number of context in
+standard conforming Fortran. This option degrades an error condition
+to a warning, and allows a BOZ literal constant to appear where the
+Fortran standard would otherwise prohibits it.
@item -fd-lines-as-code
@itemx -fd-lines-as-comments
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt (revision 273541)
+++ gcc/fortran/lang.opt (working copy)
@@ -377,6 +377,10 @@ fall-intrinsics
Fortran RejectNegative Var(flag_all_intrinsics)
All intrinsics procedures are available regardless of selected standard.
+fallow-invalid-boz
+Fortran RejectNegative Var(flag_allow_invalid_boz)
+Allow a BOZ literal constant to appear in an invalid context.
+
fallow-leading-underscore
Fortran Undocumented Var(flag_allow_leading_underscore)
; For internal use only: allow the first character of symbol names to be an underscore
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (revision 273541)
+++ gcc/fortran/libgfortran.h (working copy)
@@ -174,6 +174,6 @@ typedef enum
typedef enum
{ BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
- BT_ASSUMED, BT_UNION
+ BT_ASSUMED, BT_UNION, BT_BOZ
}
bt;
Index: gcc/fortran/misc.c
===================================================================
--- gcc/fortran/misc.c (revision 273541)
+++ gcc/fortran/misc.c (working copy)
@@ -100,6 +100,9 @@ gfc_basic_typename (bt type)
case BT_VOID:
p = "VOID";
break;
+ case BT_BOZ:
+ p = "BOZ";
+ break;
case BT_UNKNOWN:
p = "UNKNOWN";
break;
@@ -168,6 +171,9 @@ gfc_typename (gfc_typespec *ts)
break;
case BT_PROCEDURE:
strcpy (buffer, "PROCEDURE");
+ break;
+ case BT_BOZ:
+ strcpy (buffer, "BOZ");
break;
case BT_UNKNOWN:
strcpy (buffer, "UNKNOWN");
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 273541)
+++ gcc/fortran/primary.c (working copy)
@@ -189,7 +189,56 @@ match_digits (int signflag, int radix, char *buffer)
return length;
}
+/* Convert an integer string to an expression node. */
+static gfc_expr *
+convert_integer (const char *buffer, int kind, int radix, locus *where)
+{
+ gfc_expr *e;
+ const char *t;
+
+ e = gfc_get_constant_expr (BT_INTEGER, kind, where);
+ /* A leading plus is allowed, but not by mpz_set_str. */
+ if (buffer[0] == '+')
+ t = buffer + 1;
+ else
+ t = buffer;
+ mpz_set_str (e->value.integer, t, radix);
+
+ return e;
+}
+
+
+/* Convert a real string to an expression node. */
+
+static gfc_expr *
+convert_real (const char *buffer, int kind, locus *where)
+{
+ gfc_expr *e;
+
+ e = gfc_get_constant_expr (BT_REAL, kind, where);
+ mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
+
+ return e;
+}
+
+
+/* Convert a pair of real, constant expression nodes to a single
+ complex expression node. */
+
+static gfc_expr *
+convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
+{
+ gfc_expr *e;
+
+ e = gfc_get_constant_expr (BT_COMPLEX, kind, &real->where);
+ mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
+ GFC_MPC_RND_MODE);
+
+ return e;
+}
+
+
/* Match an integer (digit string and optional kind).
A sign will be accepted if signflag is set. */
@@ -231,7 +280,7 @@ match_integer_constant (gfc_expr **result, int signfla
return MATCH_ERROR;
}
- e = gfc_convert_integer (buffer, kind, 10, &gfc_current_locus);
+ e = convert_integer (buffer, kind, 10, &gfc_current_locus);
e->ts.is_c_interop = is_iso_c;
if (gfc_range_check (e) != ARITH_OK)
@@ -337,7 +386,7 @@ cleanup:
static match
match_boz_constant (gfc_expr **result)
{
- int radix, length, x_hex, kind;
+ int radix, length, x_hex;
locus old_loc, start_loc;
char *buffer, post, delim;
gfc_expr *e;
@@ -383,9 +432,9 @@ match_boz_constant (gfc_expr **result)
goto backup;
if (x_hex
- && (!gfc_notify_std(GFC_STD_GNU, "Hexadecimal "
- "constant at %C uses non-standard syntax")))
- return MATCH_ERROR;
+ && gfc_invalid_boz ("Hexadecimal constant at %L uses "
+ "nonstandard syntax", &gfc_current_locus))
+ return MATCH_ERROR;
old_loc = gfc_current_locus;
@@ -421,8 +470,8 @@ match_boz_constant (gfc_expr **result)
goto backup;
}
- if (!gfc_notify_std (GFC_STD_GNU, "BOZ constant "
- "at %C uses non-standard postfix syntax"))
+ if (gfc_invalid_boz ("BOZ constant at %C uses nonstandard postfix "
+ "syntax", &gfc_current_locus))
return MATCH_ERROR;
}
@@ -436,30 +485,20 @@ match_boz_constant (gfc_expr **result)
if (post == 1)
gfc_next_ascii_char (); /* Eat postfixed b, o, z, or x. */
- /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find
- "If a data-stmt-constant is a boz-literal-constant, the corresponding
- variable shall be of type integer. The boz-literal-constant is treated
- as if it were an int-literal-constant with a kind-param that specifies
- the representation method with the largest decimal exponent range
- supported by the processor." */
+ e = gfc_get_expr ();
+ e->expr_type = EXPR_CONSTANT;
+ e->ts.type = BT_BOZ;
+ e->where = gfc_current_locus;
+ e->boz.rdx = radix;
+ e->boz.len = length;
+ e->boz.str = XCNEWVEC (char, length + 1);
+ strncpy (e->boz.str, buffer, length);
- 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);
- gfc_free_expr (e);
- return MATCH_ERROR;
- }
-
+ /* FIXME BOZ. */
if (!gfc_in_match_data ()
&& (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
- "statement at %C")))
- return MATCH_ERROR;
+ "statement at %L", &e->where)))
+ return MATCH_ERROR;
*result = e;
return MATCH_YES;
@@ -715,7 +754,7 @@ done:
}
}
- e = gfc_convert_real (buffer, kind, &gfc_current_locus);
+ e = convert_real (buffer, kind, &gfc_current_locus);
if (negate)
mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE);
e->ts.is_c_interop = is_iso_c;
@@ -1433,7 +1472,7 @@ match_complex_constant (gfc_expr **result)
if (imag->ts.type != BT_REAL || kind != imag->ts.kind)
gfc_convert_type (imag, &target, 2);
- e = gfc_convert_complex (real, imag, kind);
+ e = convert_complex (real, imag, kind);
e->where = gfc_current_locus;
gfc_free_expr (real);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 273541)
+++ gcc/fortran/resolve.c (working copy)
@@ -10473,44 +10473,32 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace
lhs = code->expr1;
rhs = code->expr2;
- if (rhs->is_boz
- && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
- "a DATA statement and outside INT/REAL/DBLE/CMPLX",
- &code->loc))
- return false;
-
/* Handle the case of a BOZ literal on the RHS. */
- if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
+ if (rhs->ts.type == BT_BOZ)
{
- int rc;
- if (warn_surprising)
- gfc_warning (OPT_Wsurprising,
- "BOZ literal at %L is bitwise transferred "
- "non-integer symbol %qs", &code->loc,
- lhs->symtree->n.sym->name);
-
- if (!gfc_convert_boz (rhs, &lhs->ts))
+ if (gfc_invalid_boz ("BOZ literal constant at %L is neither a DATA "
+ "statement value nor an actual argument of "
+ "INT/REAL/DBLE/CMPLX intrinsic subprogram",
+ &rhs->where))
return false;
- if ((rc = gfc_range_check (rhs)) != ARITH_OK)
+
+ switch (lhs->ts.type)
{
- if (rc == ARITH_UNDERFLOW)
- gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rhs->where);
- else if (rc == ARITH_OVERFLOW)
- gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rhs->where);
- else if (rc == ARITH_NAN)
- gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
- ". This check can be disabled with the option "
- "%<-fno-range-check%>", &rhs->where);
+ case BT_INTEGER:
+ if (!gfc_boz2int (rhs, lhs->ts.kind))
+ return false;
+ break;
+ case BT_REAL:
+ if (!gfc_boz2real (rhs, lhs->ts.kind))
+ return false;
+ break;
+ default:
+ gfc_error ("Invalid use of BOZ literal constant at %L", &rhs->where);
return false;
}
}
- if (lhs->ts.type == BT_CHARACTER
- && warn_character_truncation)
+ if (lhs->ts.type == BT_CHARACTER && warn_character_truncation)
{
HOST_WIDE_INT llen = 0, rlen = 0;
if (lhs->ts.u.cl != NULL
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 273541)
+++ gcc/fortran/simplify.c (working copy)
@@ -211,26 +211,6 @@ gfc_convert_mpz_to_signed (mpz_t x, int bitsize)
}
-/* In-place convert BOZ to REAL of the specified kind. */
-
-static gfc_expr *
-convert_boz (gfc_expr *x, int kind)
-{
- if (x && x->ts.type == BT_INTEGER && x->is_boz)
- {
- gfc_typespec ts;
- gfc_clear_ts (&ts);
- ts.type = BT_REAL;
- ts.kind = kind;
-
- if (!gfc_convert_boz (x, &ts))
- return &gfc_bad_expr;
- }
-
- return x;
-}
-
-
/* Test that the expression is a constant array, simplifying if
we are dealing with a parameter array. */
@@ -1660,12 +1640,6 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_exp
{
gfc_expr *result;
- if (convert_boz (x, kind) == &gfc_bad_expr)
- return &gfc_bad_expr;
-
- if (convert_boz (y, kind) == &gfc_bad_expr)
- return &gfc_bad_expr;
-
if (x->expr_type != EXPR_CONSTANT
|| (y != NULL && y->expr_type != EXPR_CONSTANT))
return NULL;
@@ -2219,9 +2193,6 @@ gfc_simplify_dble (gfc_expr *e)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- if (convert_boz (e, gfc_default_double_kind) == &gfc_bad_expr)
- return &gfc_bad_expr;
-
result = gfc_convert_constant (e, BT_REAL, gfc_default_double_kind);
if (result == &gfc_bad_expr)
return &gfc_bad_expr;
@@ -2965,16 +2936,8 @@ gfc_simplify_float (gfc_expr *a)
if (a->expr_type != EXPR_CONSTANT)
return NULL;
- if (a->is_boz)
- {
- if (convert_boz (a, gfc_default_real_kind) == &gfc_bad_expr)
- return &gfc_bad_expr;
+ result = gfc_int2real (a, gfc_default_real_kind);
- result = gfc_copy_expr (a);
- }
- else
- result = gfc_int2real (a, gfc_default_real_kind);
-
return range_check (result, "FLOAT");
}
@@ -3610,6 +3573,15 @@ simplify_intconv (gfc_expr *e, int kind, const char *n
{
gfc_expr *result = NULL;
+ /* Convert BOZ to integer, and return without range checking. */
+ if (e->ts.type == BT_BOZ)
+ {
+ if (!gfc_boz2int (e, kind))
+ return NULL;
+ result = gfc_copy_expr (e);
+ return result;
+ }
+
if (e->expr_type != EXPR_CONSTANT)
return NULL;
@@ -6497,6 +6469,21 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
gfc_expr *result = NULL;
int kind;
+ /* Convert BOZ to real, and return without range checking. */
+ if (e->ts.type == BT_BOZ)
+ {
+ /* Determine kind for conversion of the BOZ. */
+ if (k)
+ gfc_extract_int (k, &kind);
+ else
+ kind = gfc_default_real_kind;
+
+ if (!gfc_boz2real (e, kind))
+ return NULL;
+ result = gfc_copy_expr (e);
+ return result;
+ }
+
if (e->ts.type == BT_COMPLEX)
kind = get_kind (BT_REAL, k, "REAL", e->ts.kind);
else
@@ -6507,9 +6494,6 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
-
- if (convert_boz (e, kind) == &gfc_bad_expr)
- return &gfc_bad_expr;
result = gfc_convert_constant (e, BT_REAL, kind);
if (result == &gfc_bad_expr)
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c (revision 273541)
+++ gcc/fortran/target-memory.c (working copy)
@@ -769,35 +769,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
int index;
unsigned char *buffer;
- if (!expr->is_boz)
+ if (expr->ts.type != BT_INTEGER)
return true;
- 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);
- ts_bit_size = buffer_size * 8;
- }
- else if (ts->type == BT_COMPLEX)
- {
- buffer_size = size_complex (ts->kind);
- ts_bit_size = buffer_size * 8 / 2;
- }
- else
- return true;
+ gcc_assert (ts->type == BT_REAL);
+ buffer_size = size_float (ts->kind);
+ ts_bit_size = buffer_size * 8;
+
/* Convert BOZ to the smallest possible integer kind. */
boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
- if (boz_bit_size > ts_bit_size)
- {
- gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
- &expr->where, (long) boz_bit_size, (long) ts_bit_size);
- return false;
- }
+ gcc_assert (boz_bit_size <= ts_bit_size);
for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
@@ -810,18 +794,9 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
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
- {
- mpc_init2 (expr->value.complex, mpfr_get_default_prec());
- gfc_interpret_complex (ts->kind, buffer, buffer_size,
- expr->value.complex);
- }
- expr->is_boz = 0;
+ mpfr_init (expr->value.real);
+ gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
+
expr->ts.type = ts->type;
expr->ts.kind = ts->kind;
Index: gcc/testsuite/gfortran.dg/achar_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/achar_5.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/achar_5.f90 (working copy)
@@ -37,9 +37,4 @@ program test
print *, char(huge(0_8),kind=4) ! { dg-error "too large for the collating sequence" }
print *, achar(huge(0_8),kind=4) ! { dg-error "too large for the collating sequence" }
- print *, char(z'FFFFFFFF', kind=4)
- print *, achar(z'FFFFFFFF', kind=4)
- print *, char(z'100000000', kind=4) ! { dg-error "too large for the collating sequence" }
- print *, achar(z'100000000', kind=4) ! { dg-error "too large for the collating sequence" }
-
end program test
Index: gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 (working copy)
@@ -3,8 +3,10 @@
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
+! In F2008 and F2018, overflow cannot happen, but a BOZ cannot appear
+! in an array constructor.
+!
program bug
implicit none
- integer(1) :: a(2) = (/ Z'FF', Z'FF' /) ! { dg-error "Arithmetic overflow" }
- print*, a
+ integer(1) :: a(2) = (/ Z'FF', Z'FF' /) ! { dg-error "cannot appear in" }
end program bug
Index: gcc/testsuite/gfortran.dg/boz_11.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_11.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_11.f90 (working copy)
@@ -12,16 +12,5 @@ program test0
if (cmplx(b'01000000001010010101001111111101',x,4) /= r) STOP 1
if (cmplx(x,b'01000000001010010101001111111101',4) /= z) STOP 2
- if (complex(b'01000000001010010101001111111101',0) /= r) STOP 3
- if (complex(0,b'01000000001010010101001111111101') /= z) STOP 4
-
- !if (cmplx(b'00000000000000000000000000000000&
- ! &01000000001010010101001111111101',x,8) /= rd) STOP 5
- !if (cmplx(x,b'00000000000000000000000000000000&
- ! &01000000001010010101001111111101',8) /= zd) STOP 6
- !if (dcmplx(b'00000000000000000000000000000000&
- ! &01000000001010010101001111111101',x) /= rd) STOP 7
- !if (dcmplx(x,b'00000000000000000000000000000000&
- ! &01000000001010010101001111111101') /= zd) STOP 8
end program test0
Index: gcc/testsuite/gfortran.dg/boz_12.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_12.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_12.f90 (working copy)
@@ -4,11 +4,8 @@ program test
implicit none
real x4
double precision x8
-
x4 = 1.7
x8 = 1.7
- write(*,*) complex(x4,z'1FFFFFFFF') ! { dg-error "too" }
- write(*,*) cmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
- write(*,*) complex(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
- write(*,*) dcmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+ write(*,*) cmplx(x8,z'1FFFFFFFFFFFFFFFF')
+ write(*,*) dcmplx(x8,z'1FFFFFFFFFFFFFFFF')
end program test
Index: gcc/testsuite/gfortran.dg/boz_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_4.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_4.f90 (working copy)
@@ -1,29 +1,20 @@
! { dg-do compile }
! Test that the conversion of a BOZ constant that is too large for the
! integer variable is caught by the compiler.
+!
+! In F2008 and F2018, overflow cannot happen.
+!
program boz
-
implicit none
-
- integer(1), parameter :: &
- & b1 = b'0101010110101010' ! { dg-error "overflow converting" }
- integer(2), parameter :: &
- & b2 = b'01110000111100001111000011110000' ! { dg-error "overflow converting" }
+ integer(1), parameter :: b1 = b'0101010110101010'
+ integer(2), parameter :: b2 = b'01110000111100001111000011110000'
integer(4), parameter :: &
- & b4 = b'0111000011110000111100001111000011110000111100001111000011110000' ! { dg-error "overflow converting" }
-
- integer(1), parameter :: &
- & o1 = o'1234567076543210' ! { dg-error "overflow converting" }
- integer(2), parameter :: &
- & o2 = o'1234567076543210' ! { dg-error "overflow converting" }
- integer(4), parameter :: &
- & o4 = o'1234567076543210' ! { dg-error "overflow converting" }
-
- integer(1), parameter :: &
- & z1 = z'deadbeef' ! { dg-error "overflow converting" }
- integer(2), parameter :: &
- & z2 = z'deadbeef' ! { dg-error "overflow converting" }
- integer(4), parameter :: &
- & z4 = z'deadbeeffeed' ! { dg-error "overflow converting" }
-
+ & b4 = b'0111000011110000111100001111000011110000111100001111000011110000'
+ integer(1), parameter :: o1 = o'1234567076543210'
+ integer(2), parameter :: o2 = o'1234567076543210'
+ integer(4), parameter :: o4 = o'1234567076543210'
+ integer(1), parameter :: z1 = z'deadbeef'
+ integer(2), parameter :: z2 = z'deadbeef'
+ integer(4), parameter :: z4 = z'deadbeeffeed'
end program boz
+! { dg-prune-output "BOZ literal at" }
Index: gcc/testsuite/gfortran.dg/boz_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_5.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_5.f90 (working copy)
@@ -1,4 +1,4 @@
! { dg-do compile }
integer, dimension (2) :: i
- i = (/Z'abcde', Z'abcde/) ! { dg-error "Illegal character" }
+ i = (/Z'abcde', Z'abcde/) ! { dg-error "cannot appear in" }
end
Index: gcc/testsuite/gfortran.dg/boz_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_6.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_6.f90 (working copy)
@@ -1,13 +1,13 @@
! { dg-do run }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -fallow-invalid-boz" }
! PR 24917
program test
integer ib, io, iz, ix
integer jb, jo, jz, jx
- data ib, jb /b'111', '111'b/
- data io, jo /o'234', '234'o/
- data iz, jz /z'abc', 'abc'z/
- data ix, jx /x'abc', 'abc'x/
+ data ib, jb /b'111', '111'b/ ! { dg-warning "nonstandard" }
+ data io, jo /o'234', '234'o/ ! { dg-warning "nonstandard" }
+ data iz, jz /z'abc', 'abc'z/ ! { dg-warning "nonstandard" }
+ data ix, jx /x'abc', 'abc'x/ ! { dg-warning "nonstandard" }
if (ib /= jb) STOP 1
if (io /= jo) STOP 2
if (iz /= jz) STOP 3
Index: gcc/testsuite/gfortran.dg/boz_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_7.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_7.f90 (working copy)
@@ -7,6 +7,6 @@
!
integer :: k, m
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" }
+data k/x'0003'/ ! { dg-error "nonstandard syntax" }
+data m/'0003'z/ ! { dg-error "nonstandard postfix" }
end
Index: gcc/testsuite/gfortran.dg/boz_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_8.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/boz_8.f90 (working copy)
@@ -11,7 +11,7 @@
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" }
-r = real(z'FFFFFFFFF') ! { dg-error "is too large" }
+r = z'FFFF' ! { dg-error "a DATA statement value" }
+i = z'4455' ! { dg-error "a DATA statement value" }
+r = real(z'FFFFFFFFF')
end
Index: gcc/testsuite/gfortran.dg/boz_bge.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_bge.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_bge.f90 (working copy)
@@ -0,0 +1,22 @@
+! { dg-do run }
+program foo
+
+ integer :: k = 4242
+
+ if (bge(z'1234', z'5678') .neqv. .false.) stop 1
+ if (bgt(z'1234', z'5678') .neqv. .false.) stop 2
+ if (ble(z'1234', z'5678') .eqv. .false.) stop 3
+ if (blt(z'1234', z'5678') .eqv. .false.) stop 4
+
+ if (bge(z'1234', k) .eqv. .false.) stop 5
+ if (bgt(z'1234', k) .eqv. .false.) stop 6
+ if (ble(z'1234', k) .neqv. .false.) stop 7
+ if (blt(z'1234', k) .neqv. .false.) stop 8
+
+ if (bge(k, z'5678') .neqv. .false.) stop 9
+ if (bgt(k, z'5678') .neqv. .false.) stop 10
+ if (ble(k, z'5678') .eqv. .false.) stop 11
+ if (blt(k, z'5678') .eqv. .false.) stop 12
+
+end program foo
+
Index: gcc/testsuite/gfortran.dg/boz_complex_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_complex_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_complex_1.f90 (working copy)
@@ -0,0 +1,17 @@
+! { dg-do compile }
+program foo
+
+ implicit none
+
+ complex(4) z
+
+ z = complex(z'4444', z'4444') ! { dg-error "cannot both be BOZ" }
+ if (real(z,4) /= 17476.0 .or. aimag(z) /= 42.0) stop 2
+
+ z = complex(z'4444', 42) ! { dg-error "cannot appear in the" }
+ if (real(z,4) /= 17476.0 .or. aimag(z) /= 42.0) stop 2
+
+ z = complex(z'44444400', 42.) ! { dg-error "cannot appear in the" }
+ if (real(z,4) /= 785.062500 .or. aimag(z) /= 42.0) stop 3
+
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_complex_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_complex_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_complex_2.f90 (working copy)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fallow-invalid-boz" }
+program foo
+
+ implicit none
+
+ complex(4) z
+
+ z = complex(z'4444', 42) ! { dg-warning "cannot appear in the" }
+ if (real(z,4) /= 17476.0 .or. aimag(z) /= 42.0) stop 2
+
+ z = complex(z'44444400', 42.) ! { dg-warning "cannot appear in the" }
+ if (real(z,4) /= 785.062500 .or. aimag(z) /= 42.0) stop 3
+
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_complex_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_complex_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_complex_3.f90 (working copy)
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fallow-invalid-boz -w" }
+program foo
+
+ implicit none
+
+ complex(4) z
+
+ z = complex(z'4444', 42)
+ if (real(z,4) /= 17476.0 .or. aimag(z) /= 42.0) stop 2
+
+ z = complex(z'44444400', 42.)
+ if (real(z,4) /= 785.062500 .or. aimag(z) /= 42.0) stop 3
+
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_dble.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_dble.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_dble.f90 (working copy)
@@ -0,0 +1,6 @@
+! { dg-do run }
+program foo
+ double precision x
+ x = dble(z"400921FB54411744");
+ if (x /= 3.1415926535_8) stop 1
+end
Index: gcc/testsuite/gfortran.dg/boz_dshift_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_dshift_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_dshift_1.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+program foo
+ integer k, n
+ k = dshiftl(z'1234',z'2345',1) ! { dg-error "cannot both be BOZ" }
+ n = dshiftr(z'1234',z'2345',1) ! { dg-error "cannot both be BOZ" }
+ if (k .eq. n) stop 1
+ k = dshiftl(z'1234',3.1415,1) ! { dg-error "must be INTEGER" }
+ n = dshiftr(2.7362,z'2345',1) ! { dg-error "must be INTEGER" }
+ if (k .eq. n) stop 2
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_dshift_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_dshift_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_dshift_2.f90 (working copy)
@@ -0,0 +1,12 @@
+! { dg-do run }
+program foo
+ integer k, n
+ k = dshiftl(z'1234',42,1)
+ n = dshiftr(z'1234',42,1)
+ if (k /= 9320) stop 1
+ if (n /= 21) stop 2
+ k = dshiftl(42,b'01010101', 1)
+ n = dshiftr(22,o'12345', 1)
+ if (k /= 84) stop 1
+ if (n /= 2674) stop 2
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_float_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_float_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_float_1.f90 (working copy)
@@ -0,0 +1,4 @@
+! { dg-do compile }
+program foo
+ print *, float(z'1234') ! { dg-error "cannot appear in" }
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_float_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_float_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_float_2.f90 (working copy)
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-fallow-invalid-boz" }
+program foo
+ print *, float(z'1234') ! { dg-warning "cannot appear in" }
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_float_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_float_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_float_3.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do run }
+! { dg-options "-fallow-invalid-boz -w" }
+program foo
+ integer i
+ i = float(z'1234')
+ if (i /= 4660.0) stop 1
+end program foo
Index: gcc/testsuite/gfortran.dg/boz_iand_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_iand_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_iand_1.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+program foo
+ print *, iand(z'1234', z'3456') ! { dg-error "cannot both be" }
+ print *, and(z'1234', z'3456') ! { dg-error "cannot both be" }
+ print *, ieor(z'1234', z'3456') ! { dg-error "cannot both be" }
+ print *, xor(z'1234', z'3456') ! { dg-error "cannot both be" }
+ print *, ior(z'1234', z'3456') ! { dg-error "cannot both be" }
+ print *, or(z'1234', z'3456') ! { dg-error "cannot both be" }
+end program foo
+
Index: gcc/testsuite/gfortran.dg/boz_iand_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_iand_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_iand_2.f90 (working copy)
@@ -0,0 +1,17 @@
+! { dg-do run }
+program foo
+ integer :: k = 42
+ n = iand(k, z'3456'); if (n /= 2) stop 1
+ n = iand(z'1234', k); if (n /= 32) stop 2
+ n = and(k, z'3456'); if (n /= 2) stop 3
+ n = and(z'1234', k); if (n /= 32) stop 4
+ n = ieor(k, z'3456'); if (n /= 13436) stop 5
+ n = ieor(z'1234', k); if (n /= 4638) stop 6
+ n = xor(k, z'3456'); if (n /= 13436) stop 7
+ n = xor(z'1234', k); if (n /= 4638) stop 8
+ n = ior(k, z'3456'); if (n /= 13438) stop 9
+ n = ior(z'1234', k); if (n /= 4670) stop 10
+ n = or(k, z'3456'); if (n /= 13438) stop 11
+ n = or(z'1234', k); if (n /= 4670) stop 12
+end program foo
+
Index: gcc/testsuite/gfortran.dg/boz_int.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_int.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/boz_int.f90 (working copy)
@@ -0,0 +1,13 @@
+! { dg-do run }
+program foo
+ implicit none
+ integer(1) i1
+ integer(2) i2
+ integer(4) i4, j4
+ integer(8) i8
+ i1 = int(z'12', 1); if (i1 /= 18) stop 1
+ i2 = int(z'1234', 2); if (i2 /= 4660) stop 2
+ i4 = int(z'1234', 4); if (i4 /= 4660) stop 3
+ j4 = int(z'1234'); if (i4 /= 4660) stop 4
+ i8 = int(z'1233456',8); if (i8 /= 19084374_8) stop 5
+end program
Index: gcc/testsuite/gfortran.dg/dec_structure_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dec_structure_6.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/dec_structure_6.f90 (working copy)
@@ -41,6 +41,6 @@ if ( r8.o(1) /= 9 .or. r8.o(2) /= 9 .or. r8.o(3) /= 9
if ( r8.p(1,1) /= 1 .or. r8.p(2,1) /= 2 .or. r8.p(1,2) /= 3 &
.or. r8.p(2,2) /= 4) &
call aborts ("r8.p")
-if ( r8.canary /= z'3D3D3D3D' ) call aborts ("r8.canary")
+if ( r8.canary /= int(z'3D3D3D3D') ) call aborts ("r8.canary")
end
Index: gcc/testsuite/gfortran.dg/dec_union_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dec_union_1.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/dec_union_1.f90 (working copy)
@@ -28,8 +28,8 @@ subroutine sub ()
end union
end structure
record /s6/ r6
- r6.ibuf(1) = z'badbeef'
- r6.ibuf(2) = z'badbeef'
+ r6.ibuf(1) = int(z'badbeef')
+ r6.ibuf(2) = int(z'badbeef')
end subroutine
! Repeat definition from subroutine sub with different size parameter.
@@ -55,7 +55,7 @@ integer :: r6_canary = 0
! Copied type declaration - this should not cause problems
i = 1
do while (i < siz)
- r6.ibuf(i) = z'badbeef'
+ r6.ibuf(i) = int(z'badbeef')
i = i + 1
end do
Index: gcc/testsuite/gfortran.dg/dec_union_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dec_union_2.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/dec_union_2.f90 (working copy)
@@ -31,6 +31,7 @@ structure /s1/
end map
end union
end structure
+
structure /s2/
union ! U2
map ! M4
@@ -51,9 +52,9 @@ r1.b = 1.33e7
if ( r1.a .eq. 0 ) call aborts ("basic union 1")
! Endian-agnostic runtime check
-r2.long = z'12345678'
-if (.not. ( (r2.w1 .eq. z'1234' .and. r2.w2 .eq. z'5678') &
- .or. (r2.w1 .eq. z'5678' .and. r2.w2 .eq. z'1234')) ) then
+r2.long = int(z'12345678')
+if (.not. ( (r2.w1 .eq. int(z'1234',2) .and. r2.w2 .eq. int(z'5678',2)) &
+ .or. (r2.w1 .eq. int(z'5678',2) .and. r2.w2 .eq. int(z'1234',2))) ) then
call aborts ("basic union 2")
endif
Index: gcc/testsuite/gfortran.dg/dec_union_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dec_union_5.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/dec_union_5.f90 (working copy)
@@ -25,11 +25,11 @@ end structure
record /s5/ r5
! Unions with arrays
-r5.a(1) = z'41'
-r5.a(2) = z'42'
-r5.a(3) = z'43'
-r5.a(4) = z'44'
-r5.a(5) = z'45'
+r5.a(1) = int(z'41',1)
+r5.a(2) = int(z'42',1)
+r5.a(3) = int(z'43',1)
+r5.a(4) =int( z'44',1)
+r5.a(5) = int(z'45',1)
if ( r5.s(1) .ne. 'A' &
.or. r5.s(2) .ne. 'B' &
.or. r5.s(3) .ne. 'C' &
Index: gcc/testsuite/gfortran.dg/dshift_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dshift_3.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/dshift_3.f90 (working copy)
@@ -17,7 +17,6 @@ subroutine foo(i, j, k)
print *, dshiftl(i, k, 10) ! { dg-error "must be the same type and kind" }
print *, dshiftl(k, j, 10) ! { dg-error "must be the same type and kind" }
print *, dshiftl(i, j, k)
- print *, dshiftl(i, j, z'd')
print *, dshiftr(i, j, 134) ! { dg-error "must be less than or equal" }
print *, dshiftr(z'FFF', j, 134) ! { dg-error "must be less than or equal" }
@@ -29,6 +28,5 @@ subroutine foo(i, j, k)
print *, dshiftr(i, k, 10) ! { dg-error "must be the same type and kind" }
print *, dshiftr(k, j, 10) ! { dg-error "must be the same type and kind" }
print *, dshiftr(i, j, k)
- print *, dshiftr(i, j, z'd')
end subroutine foo
Index: gcc/testsuite/gfortran.dg/gnu_logical_1.F
===================================================================
--- gcc/testsuite/gfortran.dg/gnu_logical_1.F (revision 273541)
+++ gcc/testsuite/gfortran.dg/gnu_logical_1.F (nonexistent)
@@ -1,91 +0,0 @@
-! Testcases for the AND, OR and XOR functions (GNU intrinsics).
-! { dg-do run }
-! { dg-options "-ffixed-line-length-none" }
- integer(kind=1) i1, j1
- integer(kind=2) i2, j2
- integer i4, j4
- integer(kind=8) i8, j8
- logical(kind=1) l1, k1
- logical(kind=2) l2, k2
- logical l4, k4
- logical(kind=8) l8, k8
-
-#define TEST_INTEGER(u,ukind,v,vkind) \
- ukind = u;\
- vkind = v;\
- if (iand(u,v) /= and(ukind, vkind)) STOP 1;\
- if (iand(u,v) /= and(vkind, ukind)) STOP 1;\
- if (ieor(u,v) /= xor(ukind, vkind)) STOP 1;\
- if (ieor(u,v) /= xor(vkind, ukind)) STOP 1;\
- if (ior(u,v) /= or(ukind, vkind)) STOP 1;\
- if (ior(u,v) /= or(vkind, ukind)) STOP 1
-
- TEST_INTEGER(19,i1,6,j1)
- TEST_INTEGER(19,i1,6,j2)
- TEST_INTEGER(19,i1,6,j4)
- TEST_INTEGER(19,i1,6,j8)
-
- TEST_INTEGER(19,i2,6,j1)
- TEST_INTEGER(19,i2,6,j2)
- TEST_INTEGER(19,i2,6,j4)
- TEST_INTEGER(19,i2,6,j8)
-
- TEST_INTEGER(19,i4,6,j1)
- TEST_INTEGER(19,i4,6,j2)
- TEST_INTEGER(19,i4,6,j4)
- TEST_INTEGER(19,i4,6,j8)
-
- TEST_INTEGER(19,i8,6,j1)
- TEST_INTEGER(19,i8,6,j2)
- TEST_INTEGER(19,i8,6,j4)
- TEST_INTEGER(19,i8,6,j8)
-
-
-
-#define TEST_LOGICAL(u,ukind,v,vkind) \
- ukind = u;\
- vkind = v;\
- if ((u .and. v) .neqv. and(ukind, vkind)) STOP 1;\
- if ((u .and. v) .neqv. and(vkind, ukind)) STOP 1;\
- if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(ukind, vkind)) STOP 1;\
- if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(vkind, ukind)) STOP 1;\
- if ((u .or. v) .neqv. or(ukind, vkind)) STOP 1;\
- if ((u .or. v) .neqv. or(vkind, ukind)) STOP 2
-
- TEST_LOGICAL(.true.,l1,.false.,k1)
- TEST_LOGICAL(.true.,l1,.true.,k1)
- TEST_LOGICAL(.true.,l1,.false.,k2)
- TEST_LOGICAL(.true.,l1,.true.,k2)
- TEST_LOGICAL(.true.,l1,.false.,k4)
- TEST_LOGICAL(.true.,l1,.true.,k4)
- TEST_LOGICAL(.true.,l1,.false.,k8)
- TEST_LOGICAL(.true.,l1,.true.,k8)
-
- TEST_LOGICAL(.true.,l2,.false.,k1)
- TEST_LOGICAL(.true.,l2,.true.,k1)
- TEST_LOGICAL(.true.,l2,.false.,k2)
- TEST_LOGICAL(.true.,l2,.true.,k2)
- TEST_LOGICAL(.true.,l2,.false.,k4)
- TEST_LOGICAL(.true.,l2,.true.,k4)
- TEST_LOGICAL(.true.,l2,.false.,k8)
- TEST_LOGICAL(.true.,l2,.true.,k8)
-
- TEST_LOGICAL(.true.,l4,.false.,k1)
- TEST_LOGICAL(.true.,l4,.true.,k1)
- TEST_LOGICAL(.true.,l4,.false.,k2)
- TEST_LOGICAL(.true.,l4,.true.,k2)
- TEST_LOGICAL(.true.,l4,.false.,k4)
- TEST_LOGICAL(.true.,l4,.true.,k4)
- TEST_LOGICAL(.true.,l4,.false.,k8)
- TEST_LOGICAL(.true.,l4,.true.,k8)
-
- TEST_LOGICAL(.true.,l8,.false.,k1)
- TEST_LOGICAL(.true.,l8,.true.,k1)
- TEST_LOGICAL(.true.,l8,.false.,k2)
- TEST_LOGICAL(.true.,l8,.true.,k2)
- TEST_LOGICAL(.true.,l8,.false.,k4)
- TEST_LOGICAL(.true.,l8,.true.,k4)
- TEST_LOGICAL(.true.,l8,.false.,k8)
- TEST_LOGICAL(.true.,l8,.true.,k8)
-
- end
Index: gcc/testsuite/gfortran.dg/gnu_logical_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/gnu_logical_2.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/gnu_logical_2.f90 (working copy)
@@ -7,23 +7,23 @@
print *, and(i,i)
print *, and(l,l)
- print *, and(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, and(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, and(i,l) ! { dg-error "must have the same type" }
- print *, and(l,i) ! { dg-error "must have the same type" }
+ print *, and(i,r) ! { dg-error "must be the same type" }
+ print *, and(c,l) ! { dg-error "must be the same type" }
+ print *, and(i,l) ! { dg-error "must be the same type" }
+ print *, and(l,i) ! { dg-error "must be the same type" }
print *, or(i,i)
print *, or(l,l)
- print *, or(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, or(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, or(i,l) ! { dg-error "must have the same type" }
- print *, or(l,i) ! { dg-error "must have the same type" }
+ print *, or(i,r) ! { dg-error "must be the same type" }
+ print *, or(c,l) ! { dg-error "must be the same type" }
+ print *, or(i,l) ! { dg-error "must be the same type" }
+ print *, or(l,i) ! { dg-error "must be the same type" }
print *, xor(i,i)
print *, xor(l,l)
- print *, xor(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, xor(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
- print *, xor(i,l) ! { dg-error "must have the same type" }
- print *, xor(l,i) ! { dg-error "must have the same type" }
+ print *, xor(i,r) ! { dg-error "must be the same type" }
+ print *, xor(c,l) ! { dg-error "must be the same type" }
+ print *, xor(i,l) ! { dg-error "must be the same type" }
+ print *, xor(l,i) ! { dg-error "must be the same type" }
end
Index: gcc/testsuite/gfortran.dg/int_conv_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/int_conv_1.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/int_conv_1.f90 (working copy)
@@ -1,36 +1,25 @@
! { dg-do run }
! { dg-options "-std=gnu" }
- integer(kind=2) :: i2, j2, k2, l2, m2, n2, o2
- integer(kind=4) :: i4, j4
- integer(kind=8) :: i8, j8
+ integer(kind=2) :: i2, k2, l2
+ integer(kind=8) :: i8
real :: x
complex :: z
i2 = huge(i2) / 3
i8 = int8(i2)
- i4 = long(i2)
- j2 = short(i2)
k2 = int2(i2)
l2 = int2(i8)
- m2 = short(i8)
- n2 = int2(i4)
- o2 = short(i4)
- if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2 &
- .or. l2 /= i2 .or. m2 /= i2 .or. n2 /= i2 .or. o2 /= i2) STOP 1
+ if (i8 /= i2 .or. k2 /= i2 .or. l2 /= i2 ) STOP 1
x = i2
i8 = int8(x)
- i4 = long(x)
- j2 = short(x)
k2 = int2(x)
- if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) STOP 2
+ if (i8 /= i2 .or. k2 /= i2) STOP 2
z = i2 + (0.,-42.)
i8 = int8(z)
- i4 = long(z)
- j2 = short(z)
k2 = int2(z)
- if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) STOP 3
+ if (i8 /= i2 .or. k2 /= i2) STOP 3
end
Index: gcc/testsuite/gfortran.dg/ishft_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ishft_1.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/ishft_1.f90 (working copy)
@@ -25,7 +25,6 @@ if (ishft (1_8, 0) /= 1) STOP 19
if (ishft (1_8, 1) /= 2) STOP 20
if (ishft (3_8, 1) /= 6) STOP 21
if (ishft (-1_8, 1) /= -2) STOP 22
-if (ishft (-1_8, -60) /= z'F') STOP 23
if (ishftc (1_1, 0) /= 1) STOP 24
if (ishftc (1_1, 1) /= 2) STOP 25
Index: gcc/testsuite/gfortran.dg/merge_bits_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/merge_bits_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/merge_bits_3.f90 (working copy)
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program foo
+ integer m
+ m = merge_bits(b'010101', b"101010", 42) ! { dg-error "cannot both be" }
+end program foo
Index: gcc/testsuite/gfortran.dg/merge_bits_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/merge_bits_4.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/merge_bits_4.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do run }
+program foo
+ integer m, n, k
+ m = merge_bits(b'010101', 1234, 42); if (m /= 1232) stop 1
+ n = merge_bits(1234, z'3456', 42); if (n /= 13398) stop 2
+ k = merge_bits(1234, 3456, o'12334'); if (k /= 3536) stop 3
+end program foo
Index: gcc/testsuite/gfortran.dg/nan_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nan_4.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/nan_4.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -fallow-invalid-boz" }
! { dg-add-options ieee }
! { dg-skip-if "NaN not supported" { spu-*-* } }
!
@@ -9,8 +9,8 @@
!
program test
implicit none
- real(4), parameter :: r0 = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" }
+ real(4), parameter :: r0 = z'FFFFFFFF'
real(4) r
- data r/z'FFFFFFFF'/ ! { dg-error "Arithmetic NaN" }
- r = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" }
+ data r/z'FFFFFFFF'/
+ r = z'FFFFFFFF' ! { dg-warning "neither a DATA statement value" }
end program test
Index: gcc/testsuite/gfortran.dg/no_range_check_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/no_range_check_3.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/no_range_check_3.f90 (working copy)
@@ -1,6 +1,6 @@
! { dg-do run }
-! { dg-options "-fno-range-check" }
program test
+ integer(2) :: j, k
integer :: i
i = int(z'FFFFFFFF',kind(i))
if (i /= -1) STOP 1
@@ -9,4 +9,8 @@ program test
if (popcnt(int(z'0F00F00080000001',8)) /= 10) STOP 3
if (popcnt(int(z'800F0001',4)) /= 6) STOP 4
+ j = -1234_2
+ k = int(z'FB2E',kind(j))
+ if (k /= j) STOP 5
+ if (int(z'FB2E',kind(j)) /= j) STOP 6
end program test
Index: gcc/testsuite/gfortran.dg/pr16433.f
===================================================================
--- gcc/testsuite/gfortran.dg/pr16433.f (revision 273541)
+++ gcc/testsuite/gfortran.dg/pr16433.f (working copy)
@@ -1,6 +1,6 @@
! { dg-do compile }
real x
double precision dx
- 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" }
+ data x/x'2ffde'/ ! { dg-error "Hexadecimal constant" }
+ dx = x
end
Index: gcc/testsuite/gfortran.dg/pr44491.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr44491.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/pr44491.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
! { dg-options "-std=gnu" }
! PR fortran/44491
- character*2 escape /z'1B'/ ! { dg-error "Incompatible types in DATA" }
+ character*2 escape /z'1B'/ ! { dg-error "cannot appear in" }
end
Index: gcc/testsuite/gfortran.dg/pr58027.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr58027.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/pr58027.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
! PR fortran/58027
-integer, parameter :: i(1)=(/z'ff800000'/) ! { dg-error "overflow converting" }
+integer, parameter :: i(1)=(/z'ff800000'/) ! { dg-error "cannot appear in" }
print *, isclass
end
Index: gcc/testsuite/gfortran.dg/pr81509_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr81509_2.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/pr81509_2.f90 (working copy)
@@ -12,7 +12,7 @@ k = and(i, z'1234')
k = ieor(z'ade',i)
k = ior(i,z'1111')
k = ior(i,k) ! { dg-error "different kind type parameters" }
-k = and(i,k)
-k = and(a,z'1234') ! { dg-error "must have the same type" }
+k = and(i,k) ! { dg-error "must be the same type" }
+k = and(a,z'1234') ! { dg-error "must be the same type" }
end program foo
Index: gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 (working copy)
@@ -18,9 +18,9 @@ program main
integer i
character(4) str
- 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" }
+ m(1) = int(Z'11223344')
+ m(2) = int(Z'55667788')
+ n = int(Z'77AABBCC')
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
+ if (m(1).ne.int(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
+ if (m(2).ne.int(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
+ if (n.ne.int(Z'77AABBCC')) then
if (debug) then
print '(A,Z8)','n incorrect. n = ',n
else
Index: gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 (revision 273541)
+++ gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 (working copy)
@@ -15,26 +15,28 @@ program main
close(10,status="delete")
open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
- i = (/ Z'11223344', Z'55667700' /)
+ i = (/ int(Z'11223344'), int(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' /))) &
+ if (any(b /= (/ int(Z'11',1), int(Z'22',1), int(Z'33',1), int(Z'44',1), &
+ & int(Z'55',1), int(Z'66',1), int(Z'77',1), int(Z'00',1) /))) &
STOP 2
backspace 10
read (10) j
- if (j /= Z'1122334455667700') STOP 3
+ if (j /= int(Z'1122334455667700',8)) STOP 3
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' /))) &
+ if (any(b /= (/ int(Z'44',1), int(Z'33',1), int(Z'22',1), int(Z'11',1), &
+ & int(Z'00',1), int(Z'77',1), int(Z'66',1), int(Z'55',1) /))) &
STOP 4
backspace 10
read (10) j
- if (j /= Z'5566770011223344') STOP 5
+ if (j /= int(Z'5566770011223344',8)) STOP 5
close (10, status="delete")
end program main
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 (revision 273541)
+++ gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 (working copy)
@@ -13,25 +13,25 @@ program test_exponent_fraction
x = 0.
call test_4(x)
- i = o'00000000001'
+ i = int(o'00000000001')
call test_4(x)
- i = o'00010000000'
+ i = int(o'00010000000')
call test_4(x)
- i = o'17700000000'
+ i = int(o'17700000000')
call test_4(x)
- i = o'00004000001'
+ i = int(o'00004000001')
call test_4(x)
- i = o'17737777777'
+ i = int(o'17737777777')
call test_4(x)
- i = o'10000000000'
+ i = int(o'10000000000')
call test_4(x)
- i = o'0000010000'
+ i = int(o'0000010000')
call test_4(x)
y = 0.5
@@ -40,7 +40,7 @@ program test_exponent_fraction
y = 0.
call test_8(y)
- j = o'00000000001'
+ j = int(o'00000000001',8)
call test_8(y)
y = 0.2938735877D-38
@@ -49,7 +49,7 @@ program test_exponent_fraction
y = -1.469369D-39
call test_8(y)
- y = z'7fe00000'
+ y = real(z'7fe00000',8)
call test_8(y)
y = -5.739719D+42
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 (revision 273541)
+++ gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 (working copy)
@@ -10,7 +10,7 @@ CALL mvbits(from, 2, 16, to, 1)
if (to /= result) STOP 1
to8 = 0_8
-from8 = b'1011'*2_8**32
+from8 = int(b'1011',8)*2_8**32
call mvbits (from8, 33, 3, to8, 2)
-if (to8 /= b'10100') STOP 1
+if (to8 /= int(b'10100',8)) STOP 1
end
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 (revision 273541)
+++ gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 (working copy)
@@ -11,13 +11,13 @@ program test_nearest
s = 3.0
call test_n (s, r)
- i = z'00800000'
+ i = int(z'00800000')
call test_n (s, r)
- i = z'007fffff'
+ i = int(z'007fffff')
call test_n (s, r)
- i = z'00800100'
+ i = int(z'00800100')
call test_n (s, r)
s = 0
@@ -25,9 +25,8 @@ program test_nearest
y = nearest(s, -r)
if (.not. (x .gt. s .and. y .lt. s )) STOP 1
-! ??? This is pretty sketchy, but passes on most targets.
- infi = z'7f800000'
- maxi = z'7f7fffff'
+ infi = int(z'7f800000')
+ maxi = int(z'7f7fffff')
call test_up(max, inf)
call test_up(-inf, -max)
Index: gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 (revision 273541)
+++ gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 (working copy)
@@ -16,9 +16,9 @@
integer n
real*4 r(size)
integer i
- m(1) = Z'11111111'
- m(2) = Z'22222222'
- n = Z'33333333'
+ m(1) = int(Z'11111111')
+ m(2) = int(Z'22222222')
+ n = int(Z'33333333')
do i = 1,size
r(i) = i
end do
@@ -39,7 +39,7 @@
read(9)r
!
! check results
- if (m(1).ne.Z'11111111') then
+ if (m(1).ne. int(Z'11111111')) then
if (debug) then
print '(A,Z8)','m(1) incorrect. m(1) = ',m(1)
else
@@ -47,7 +47,7 @@
endif
endif
- if (m(2).ne.Z'22222222') then
+ if (m(2).ne. int(Z'22222222')) then
if (debug) then
print '(A,Z8)','m(2) incorrect. m(2) = ',m(2)
else
@@ -55,7 +55,7 @@
endif
endif
- if (n.ne.Z'33333333') then
+ if (n.ne. int(Z'33333333')) then
if (debug) then
print '(A,Z8)','n incorrect. n = ',n
else