diff options
Diffstat (limited to 'gcc')
63 files changed, 1034 insertions, 549 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c4c35ad..7cac310 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,83 @@ +2019-07-23 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-21 Thomas König <tkoenig@gcc.gnu.org> PR libfortran/91030 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index a4f8795..ff279db 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -1892,56 +1892,6 @@ gfc_le (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op 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 *****/ diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h index e06c705..39366ca 100644 --- a/gcc/fortran/arith.h +++ b/gcc/fortran/arith.h @@ -59,11 +59,6 @@ gfc_expr *gfc_ge (gfc_expr *, gfc_expr *, gfc_intrinsic_op); 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); diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 0aee220..396dd97 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -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; } diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 9580180..1543f13 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -34,6 +34,225 @@ 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. */ @@ -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_expr *x) 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, gfc_expr *status) 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 *kind) &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, gfc_expr *stat, 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,35 +2479,30 @@ 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)) - return false; - - if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1)) + if (!same_type_check (i, 0, j, 1)) return false; if (!type_check (shift, 2, BT_INTEGER)) @@ -2204,18 +2511,8 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift) 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, gfc_expr *boundary, 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,17 +2802,25 @@ 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 (!type_check (i, 0, BT_INTEGER)) 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 (j, 1, BT_INTEGER)) + return false; if (i->ts.kind != j->ts.kind) { @@ -2658,6 +2973,10 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, 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,28 +3886,37 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) 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 (!type_check (mask, 2, BT_INTEGER)) return false; - if (mask->is_boz) mask->ts.kind = i->ts.kind; + 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; - } - - 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; - } + /* i and j cannot both be BOZ literal constants. */ + if (!boz_args_check (i, j)) + 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 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 (!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; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 3d29091..a7886b0 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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); @@ -567,6 +567,25 @@ match_old_style_init (const char *name) 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)) { gfc_error ("Initialization at %C is not allowed in a PURE procedure"); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a164370..a10a17d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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, int conform, && !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) - { - 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; - } + if (rvalue->ts.type == BT_BOZ) + { + /* 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) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b1f7bd0..700e6dc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 3f91f6b..f971586 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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) diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index f8efcd8..5d538fa 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -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 @@ -231,6 +231,13 @@ 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 @opindex @code{fd-lines-as-code} diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 88674cb..fdf5061 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -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 diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index f82fc6a..30cb6ef 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -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; diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index ec31fb9..2569f6b 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -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; @@ -169,6 +172,9 @@ gfc_typename (gfc_typespec *ts) case BT_PROCEDURE: strcpy (buffer, "PROCEDURE"); break; + case BT_BOZ: + strcpy (buffer, "BOZ"); + break; case BT_UNKNOWN: strcpy (buffer, "UNKNOWN"); break; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index e918372..da524e9 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -189,6 +189,55 @@ 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 signflag) 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." */ - - 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; - } + 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); + /* 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); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c82e8f2..70c7f82 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10473,44 +10473,32 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) 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) - { - 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); + + switch (lhs->ts.type) + { + 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 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 2d20913..5ab7c81 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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_expr *y, int kind) { 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,15 +2936,7 @@ 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_copy_expr (a); - } - else - result = gfc_int2real (a, gfc_default_real_kind); + 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 *name) { 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 @@ -6508,9 +6495,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) return &gfc_bad_expr; diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 1354c57..1b23a44 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 14fe6b9..43e7862 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,52 @@ +2019-07-23 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. + 2019-07-23 Jeff Law <law@redhat.com> PR tree-optimization/86061 diff --git a/gcc/testsuite/gfortran.dg/achar_5.f90 b/gcc/testsuite/gfortran.dg/achar_5.f90 index c4f78c0..498c6e3 100644 --- a/gcc/testsuite/gfortran.dg/achar_5.f90 +++ b/gcc/testsuite/gfortran.dg/achar_5.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 b/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 index b19844f..95b15a8 100644 --- a/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 +++ b/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_11.f90 b/gcc/testsuite/gfortran.dg/boz_11.f90 index 751dc23..c9bae41 100644 --- a/gcc/testsuite/gfortran.dg/boz_11.f90 +++ b/gcc/testsuite/gfortran.dg/boz_11.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_12.f90 b/gcc/testsuite/gfortran.dg/boz_12.f90 index 4c5c750..60a8952 100644 --- a/gcc/testsuite/gfortran.dg/boz_12.f90 +++ b/gcc/testsuite/gfortran.dg/boz_12.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_4.f90 b/gcc/testsuite/gfortran.dg/boz_4.f90 index d016df2..35113b7 100644 --- a/gcc/testsuite/gfortran.dg/boz_4.f90 +++ b/gcc/testsuite/gfortran.dg/boz_4.f90 @@ -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" } diff --git a/gcc/testsuite/gfortran.dg/boz_5.f90 b/gcc/testsuite/gfortran.dg/boz_5.f90 index 3b1994b..f4176b9 100644 --- a/gcc/testsuite/gfortran.dg/boz_5.f90 +++ b/gcc/testsuite/gfortran.dg/boz_5.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_6.f90 b/gcc/testsuite/gfortran.dg/boz_6.f90 index 379a44f..57a8beb 100644 --- a/gcc/testsuite/gfortran.dg/boz_6.f90 +++ b/gcc/testsuite/gfortran.dg/boz_6.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_7.f90 b/gcc/testsuite/gfortran.dg/boz_7.f90 index 348f561..45fa7a7 100644 --- a/gcc/testsuite/gfortran.dg/boz_7.f90 +++ b/gcc/testsuite/gfortran.dg/boz_7.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_8.f90 b/gcc/testsuite/gfortran.dg/boz_8.f90 index effce2d..0f47c67 100644 --- a/gcc/testsuite/gfortran.dg/boz_8.f90 +++ b/gcc/testsuite/gfortran.dg/boz_8.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_bge.f90 b/gcc/testsuite/gfortran.dg/boz_bge.f90 new file mode 100644 index 0000000..46891e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_bge.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/boz_complex_1.f90 b/gcc/testsuite/gfortran.dg/boz_complex_1.f90 new file mode 100644 index 0000000..e05246a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_complex_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_complex_2.f90 b/gcc/testsuite/gfortran.dg/boz_complex_2.f90 new file mode 100644 index 0000000..345027b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_complex_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_complex_3.f90 b/gcc/testsuite/gfortran.dg/boz_complex_3.f90 new file mode 100644 index 0000000..4318a7f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_complex_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_dble.f90 b/gcc/testsuite/gfortran.dg/boz_dble.f90 new file mode 100644 index 0000000..c155243 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_dble.f90 @@ -0,0 +1,6 @@ +! { dg-do run } +program foo + double precision x + x = dble(z"400921FB54411744"); + if (x /= 3.1415926535_8) stop 1 +end diff --git a/gcc/testsuite/gfortran.dg/boz_dshift_1.f90 b/gcc/testsuite/gfortran.dg/boz_dshift_1.f90 new file mode 100644 index 0000000..ba10315 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_dshift_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_dshift_2.f90 b/gcc/testsuite/gfortran.dg/boz_dshift_2.f90 new file mode 100644 index 0000000..c2fbd1b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_dshift_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_float_1.f90 b/gcc/testsuite/gfortran.dg/boz_float_1.f90 new file mode 100644 index 0000000..e444b09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_float_1.f90 @@ -0,0 +1,4 @@ +! { dg-do compile } +program foo + print *, float(z'1234') ! { dg-error "cannot appear in" } +end program foo diff --git a/gcc/testsuite/gfortran.dg/boz_float_2.f90 b/gcc/testsuite/gfortran.dg/boz_float_2.f90 new file mode 100644 index 0000000..638dae2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_float_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_float_3.f90 b/gcc/testsuite/gfortran.dg/boz_float_3.f90 new file mode 100644 index 0000000..7262495 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_float_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/boz_iand_1.f90 b/gcc/testsuite/gfortran.dg/boz_iand_1.f90 new file mode 100644 index 0000000..45d8c39 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_iand_1.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/boz_iand_2.f90 b/gcc/testsuite/gfortran.dg/boz_iand_2.f90 new file mode 100644 index 0000000..e656ac0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_iand_2.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/boz_int.f90 b/gcc/testsuite/gfortran.dg/boz_int.f90 new file mode 100644 index 0000000..79302cd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/boz_int.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/dec_structure_6.f90 b/gcc/testsuite/gfortran.dg/dec_structure_6.f90 index 91a4df9..69ff50c 100644 --- a/gcc/testsuite/gfortran.dg/dec_structure_6.f90 +++ b/gcc/testsuite/gfortran.dg/dec_structure_6.f90 @@ -41,6 +41,6 @@ if ( r8.o(1) /= 9 .or. r8.o(2) /= 9 .or. r8.o(3) /= 9 ) call aborts ("r8.o") 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 diff --git a/gcc/testsuite/gfortran.dg/dec_union_1.f90 b/gcc/testsuite/gfortran.dg/dec_union_1.f90 index 074782c..689628c 100644 --- a/gcc/testsuite/gfortran.dg/dec_union_1.f90 +++ b/gcc/testsuite/gfortran.dg/dec_union_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/dec_union_2.f90 b/gcc/testsuite/gfortran.dg/dec_union_2.f90 index 99db431..4e23955 100644 --- a/gcc/testsuite/gfortran.dg/dec_union_2.f90 +++ b/gcc/testsuite/gfortran.dg/dec_union_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/dec_union_5.f90 b/gcc/testsuite/gfortran.dg/dec_union_5.f90 index f3cca5d..712b9a4 100644 --- a/gcc/testsuite/gfortran.dg/dec_union_5.f90 +++ b/gcc/testsuite/gfortran.dg/dec_union_5.f90 @@ -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' & diff --git a/gcc/testsuite/gfortran.dg/dshift_3.f90 b/gcc/testsuite/gfortran.dg/dshift_3.f90 index 1f214c7..2ed2840 100644 --- a/gcc/testsuite/gfortran.dg/dshift_3.f90 +++ b/gcc/testsuite/gfortran.dg/dshift_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_1.F b/gcc/testsuite/gfortran.dg/gnu_logical_1.F index 19e368c..e69de29 100644 --- a/gcc/testsuite/gfortran.dg/gnu_logical_1.F +++ b/gcc/testsuite/gfortran.dg/gnu_logical_1.F @@ -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 diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 index 4ff70fa..a7b31b4 100644 --- a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 +++ b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/int_conv_1.f90 b/gcc/testsuite/gfortran.dg/int_conv_1.f90 index a3e8783..daf0dfd 100644 --- a/gcc/testsuite/gfortran.dg/int_conv_1.f90 +++ b/gcc/testsuite/gfortran.dg/int_conv_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/ishft_1.f90 b/gcc/testsuite/gfortran.dg/ishft_1.f90 index 82fdb02..ffac323 100644 --- a/gcc/testsuite/gfortran.dg/ishft_1.f90 +++ b/gcc/testsuite/gfortran.dg/ishft_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/merge_bits_3.f90 b/gcc/testsuite/gfortran.dg/merge_bits_3.f90 new file mode 100644 index 0000000..8193b32 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/merge_bits_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/merge_bits_4.f90 b/gcc/testsuite/gfortran.dg/merge_bits_4.f90 new file mode 100644 index 0000000..5622ecb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/merge_bits_4.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/nan_4.f90 b/gcc/testsuite/gfortran.dg/nan_4.f90 index 46aba3e..707f9e9 100644 --- a/gcc/testsuite/gfortran.dg/nan_4.f90 +++ b/gcc/testsuite/gfortran.dg/nan_4.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/no_range_check_3.f90 b/gcc/testsuite/gfortran.dg/no_range_check_3.f90 index ffab312..4653ff0 100644 --- a/gcc/testsuite/gfortran.dg/no_range_check_3.f90 +++ b/gcc/testsuite/gfortran.dg/no_range_check_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/pr16433.f b/gcc/testsuite/gfortran.dg/pr16433.f index cb3dcec..925eb52 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 "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 diff --git a/gcc/testsuite/gfortran.dg/pr44491.f90 b/gcc/testsuite/gfortran.dg/pr44491.f90 index 406bb26..3bd31c4 100644 --- a/gcc/testsuite/gfortran.dg/pr44491.f90 +++ b/gcc/testsuite/gfortran.dg/pr44491.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/pr58027.f90 b/gcc/testsuite/gfortran.dg/pr58027.f90 index bef893c..7398c6c 100644 --- a/gcc/testsuite/gfortran.dg/pr58027.f90 +++ b/gcc/testsuite/gfortran.dg/pr58027.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/pr81509_2.f90 b/gcc/testsuite/gfortran.dg/pr81509_2.f90 index 919cb4e..a0618cc 100644 --- a/gcc/testsuite/gfortran.dg/pr81509_2.f90 +++ b/gcc/testsuite/gfortran.dg/pr81509_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 index 1baa7f5..61d982d 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 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 diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 index e9092cb..cc5ab4d 100644 --- a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 +++ b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 index ed7e2f1..ce7f0fb 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 index c423d4f..13ff85e 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 index ec2bc18..222da0a 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 index dadab92..54f2aa7 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 @@ -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 |