* [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
@ 2017-10-06 20:34 Steve Kargl
2017-10-07 4:30 ` Jerry DeLisle
0 siblings, 1 reply; 7+ messages in thread
From: Steve Kargl @ 2017-10-06 20:34 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 4569 bytes --]
All,
I have spent the last few days trying to reconcile the various Fortran
standards' requirements for handling BOZ. The short story is that J3
over the last 27 years has made incompatible changes to the interpretation
of a BOZ (under some circumstances). The interpretations in F2008 and
F2015 now treat a boz-literal-constant as a sequence of bits. Unfortunately,
due to quirks in how BOZ are currently implemented in gfortran and a boat
load of documented and undocumented extensions, bringing gfortran into
agreement with F2008/F2015 led to a rewrite of BOZ handling. In the
rewrite I have made no attempt to use the -std= option to try to maintain
the incompatibilities between standards.
On x86_64-*-freebsd, the attached patch gives
tail gcc/testsuite/gfortran/gfortran.sum
=== gfortran Summary ===
# of expected passes 45888
# of unexpected failures 4
# of unexpected successes 6
# of expected failures 97
# of unsupported tests 79
/home/sgk/gcc/obj/gcc/gfortran version 8.0.0 20170927 (experimental) (GCC)
The 4 unexpected failures are not related to this patch.
2017-10-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/45513
PR fortran/54072
PR fortran/81509
* array.c (resolve_array_list): Handle an array descriptor
with BOZ elements.
* check.c (numeric_check): Error for BOZ when numeric type is expected.
(numeric_or_boz_check): New function. Check for numeric or BOZ arg.
(int_or_boz_check): New function. Check for INTEGER or BOZ arg.
(gfc_check_bge_bgt_ble_blt): Use int_or_boz_check.
(gfc_check_cmplx): Use numeric_or_boz_check.
(gfc_check_complex): Permit BOZ arguments.
(gfc_check_dcmplx): Use numeric_or_boz_check.
(gfc_check_dble): Allow BOZ argument.
(boz_args_check): New function. Disallow two BOZ arguments.
(gfc_boz2int): New function. In-place conversion of BOZ to INTEGER.
(gfc_check_dshift): Use int_or_boz_check, boz_args_check, gfc_boz2int.
(gfc_check_iand): Renamed to ...
(gfc_check_iand_ieor_ior): ... this. Use int_or_boz_check,
boz_args_check, and gfc_boz2int. Convert gfc_notify_std to gfc_error.
(gfc_check_ieor, gfc_check_ior): Removed function.
(gfc_check_int): Use numeric_or_boz_check
(gfc_check_merge_bits): Use int_or_boz_check, boz_args_check,
gfc_boz2int
(gfc_check_real): Allow BOZ. Use numeric_or_boz_check.
(gfc_check_and): Allow BOZ. Use boz_args_check and gfc_boz2int
* data.c (gfc_assign_data_value): Implement F2008/F2015 sematics for
for BOZ in data statement.
* expr.c (gfc_get_expr): Set boz component of gfc_expr to NULL.
(gfc_copy_expr, free_expr0): Cope new boz component.
(gfc_check_assign): Replace old is_boz checks with BT_BOZ checks.
Use gfc_boz2int.
* gfortran.h (gfc_expr): Remove is_boz component. Add boz
component. Add prototyp gfc_boz2int.
* intrinsic.c (add_functions): Use gfc_check_iand_ieor_ior
in place of gfc_check_iand, gfc_check_ieor, and gfc_check_ior.
* intrinsic.h: Add prototype for gfc_check_iand_ieor_ior.
Remove prototypes for gfc_check_iand, gfc_check_ieor, gfc_check_ior.
* intrinsic.texi: Document (some) changes.
* iresolve.c(gfc_resolve_iand,gfc_resolve_ieor,gfc_resolve_ior): Mark
j with ATTRIBUTE_UNUSED. Make IAND, IEOR, IOR
conform to F2008/2015.
* libgfortran.h: Add new basic type BT_BOZ.
* primary.c (match_boz_constant): Remove old handling of BOZ.
Cache BOZ string in gfc_expr's boz component.
* resolve.c (resolve_operator): Allow BOZ in binary
numeric and rational operators. Use gfc_boz2int or gfc_convert_boz
as needed.
(resolve_allocate_expr): Split declaration and initialization.
(resolve_ordinary_assign): Replace is_boz checks with BT_BOZ checks.
* simplify.c (convert_boz): Replace BT_INTEGER with BT_BOZ
(simplify_cmplx): Rearrange allow simplication of individual args.
Convert BOZ as needed.
(gfc_simplify_complex): Account of args with BT_BOZ.
(gfc_simplify_float): Replace is_boz check with BT_BOZ check.
(simplify_intconv): In-place conversin of boz to INTEGER.
* target-memory.c (boz2int): New function. Conversion of
boz to INTEGER with widest decimal range.
(gfc_convert_boz): Use it. Remove clearly is_boz.
2017-10-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/45513
PR fortran/54072
PR fortran/81509
* gfortran.dg/achar_5.f90: Remove BOZ arg tests.
* gfortran.dg/boz_4.f90: Delete test as it no longer applies.
* gfortran.dg/graphite/id-26.f03: Fix test.
* gfortran.dg/pr81509_1.f90: New test.
* gfortran.dg/pr81509_2.f90: New test.
* gfortran.dg/unf_io_convert_2.f90: Fix test.
[-- Attachment #2: boz.diff --]
[-- Type: text/x-diff, Size: 48603 bytes --]
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 253236)
+++ gcc/fortran/array.c (working copy)
@@ -1896,10 +1896,12 @@ find_symbol_in_expr (gfc_symbol *sym, gfc_expr *expr,
static bool
resolve_array_list (gfc_constructor_base base)
{
+ bool saw_boz;
bool t;
gfc_constructor *c;
gfc_iterator *iter;
+ saw_boz = false;
t = true;
for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
@@ -1942,11 +1944,46 @@ resolve_array_list (gfc_constructor_base base)
if (!gfc_resolve_expr (c->expr))
t = false;
+ if (c->expr->ts.type == BT_BOZ)
+ saw_boz = true;
+
if (UNLIMITED_POLY (c->expr))
{
gfc_error ("Array constructor value at %L shall not be unlimited "
"polymorphic [F2008: C4106]", &c->expr->where);
t = false;
+ }
+ }
+
+ /* If an array contains a BT_BOZ, then array elements need to be converted
+ an INTEGER. This is an GNU Fortran extension. Mixing BOZ and non-BOZ
+ entities is not permitted. */
+ if (saw_boz)
+ {
+ bt type = BT_UNKNOWN;
+
+ c = gfc_constructor_first (base);
+ for (; c; c = gfc_constructor_next (c))
+ if (c->expr->ts.type != BT_BOZ)
+ {
+ gfc_error ("Type mismatch at %L with elements in an array "
+ "constructor due to a boz-literal-constant array element",
+ &c->expr->where);
+ return false;
+ }
+
+ /* All elements are BT_BOZ, so convert to INTEGER. */
+ if (type == BT_UNKNOWN)
+ {
+ gfc_expr *e;
+ c = gfc_constructor_first (base);
+ for (; c; c = gfc_constructor_next (c))
+ {
+ e = gfc_get_constant_expr (BT_INTEGER, gfc_max_integer_kind,
+ &c->expr->where);
+ gfc_boz2int (c->expr, e);
+ gfc_free_expr (e);
+ }
}
}
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 253236)
+++ gcc/fortran/check.c (working copy)
@@ -93,7 +93,47 @@ numeric_check (gfc_expr *e, int n)
error:
- gfc_error ("%qs argument of %qs intrinsic at %L must have a numeric type",
+ if (e->ts.type == BT_BOZ)
+ gfc_error ("%qs argument of %qs intrinsic at %L cannot be a "
+ "boz-literal-constant", gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ else
+ gfc_error ("%qs argument of %qs intrinsic at %L must have a numeric type",
+ gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+ &e->where);
+
+ return false;
+}
+
+/* Check that the expression is a numeric type or boz-literal-constant. */
+
+static bool
+numeric_or_boz_check (gfc_expr *e, int n)
+{
+ /* Users sometime use a subroutine designator as an actual argument to
+ an intrinsic subprogram that expects an argument with a numeric type. */
+ if (e->symtree && e->symtree->n.sym->attr.subroutine)
+ goto error;
+
+ if (e->ts.type == BT_BOZ || e->ts.type == BT_COMPLEX
+ || e->ts.type == BT_INTEGER || e->ts.type == BT_REAL)
+ return true;
+
+ /* If the expression has not got a type, check if its namespace can
+ offer a default type. */
+ if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION)
+ && e->symtree->n.sym->ts.type == BT_UNKNOWN
+ && gfc_set_default_type (e->symtree->n.sym, 0, e->symtree->n.sym->ns)
+ && gfc_numeric_ts (&e->symtree->n.sym->ts))
+ {
+ e->ts = e->symtree->n.sym->ts;
+ return true;
+ }
+
+error:
+
+ gfc_error ("%qs argument of %qs intrinsic at %L must either have a numeric "
+ "type or be a boz-literal-constant",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
@@ -118,6 +158,22 @@ int_or_real_check (gfc_expr *e, int n)
}
+/* Check that an expression is integer or boz-literal-constant. */
+
+static bool
+int_or_boz_check (gfc_expr *e, int n)
+{
+ if (e->ts.type != BT_INTEGER && e->ts.type != BT_BOZ)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER or a "
+ "boz-literal-constant", gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ return false;
+ }
+
+ return true;
+}
+
/* Check that an expression is real or complex. */
static bool
@@ -1404,10 +1460,10 @@ 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)
{
- if (!type_check (i, 0, BT_INTEGER))
+ if (!int_or_boz_check (i, 0))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ if (!int_or_boz_check (j, 1))
return false;
return true;
@@ -1523,12 +1579,12 @@ gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, g
bool
gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
{
- if (!numeric_check (x, 0))
+ if (x->ts.type != BT_BOZ && !numeric_or_boz_check (x, 0))
return false;
if (y != NULL)
{
- if (!numeric_check (y, 1))
+ if (y->ts.type != BT_BOZ && !numeric_or_boz_check (y, 1))
return false;
if (x->ts.type == BT_COMPLEX)
@@ -1859,13 +1915,27 @@ gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image,
bool
gfc_check_complex (gfc_expr *x, gfc_expr *y)
{
- if (!int_or_real_check (x, 0))
- return false;
+ if (x->ts.type != BT_BOZ && x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER or "
+ "REAL or boz-literal-constant",
+ gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+ &x->where);
+ return false;
+ }
+
if (!scalar_check (x, 0))
return false;
- if (!int_or_real_check (y, 1))
- return false;
+ if (y->ts.type != BT_BOZ && y->ts.type != BT_INTEGER && y->ts.type != BT_REAL)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER or "
+ "REAL or boz-literal-constant",
+ gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+ &y->where);
+ return false;
+ }
+
if (!scalar_check (y, 1))
return false;
@@ -1980,12 +2050,12 @@ bool gfc_check_datan2 (gfc_expr *y, gfc_expr *x)
bool
gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
{
- if (!numeric_check (x, 0))
+ if (x->ts.type != BT_BOZ && !numeric_or_boz_check (x, 0))
return false;
if (y != NULL)
{
- if (!numeric_check (y, 1))
+ if (y->ts.type != BT_BOZ && !numeric_or_boz_check (y, 1))
return false;
if (x->ts.type == BT_COMPLEX)
@@ -2014,6 +2084,9 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
bool
gfc_check_dble (gfc_expr *x)
{
+ if (x->ts.type == BT_BOZ)
+ return true;
+
if (!numeric_check (x, 0))
return false;
@@ -2101,42 +2174,84 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
}
+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;
+}
+
+/* Given a BT_BOZ in i, convert to an BT_INTEGER with kind of j. */
+
+void
+gfc_boz2int (gfc_expr *i, gfc_expr *j)
+{
+ char *t;
+ int radix;
+
+ i->ts.type = BT_INTEGER;
+ i->ts.kind = j->ts.kind;
+
+ t = i->boz;
+ radix = 16;
+ if (*t == 'b') radix = 2;
+ if (*t++ == 'o') radix = 8;
+
+ mpz_init (i->value.integer);
+ mpz_set_str (i->value.integer, t, radix);
+}
+
+
bool
gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
{
- if (!type_check (i, 0, BT_INTEGER))
+ if (!int_or_boz_check (i, 0))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ if (!int_or_boz_check (j, 1))
return false;
- if (i->is_boz && j->is_boz)
- {
- gfc_error ("%<I%> at %L and %<J%>' at %L cannot both be BOZ literal "
- "constants", &i->where, &j->where);
- 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 (i->ts.type == BT_BOZ)
+ gfc_boz2int (i, j);
+
+ if (j->ts.type == BT_BOZ)
+ gfc_boz2int (j, i);
+
+ if (!same_type_check (i, 0, j, 1))
return false;
- if (!type_check (shift, 2, BT_INTEGER))
+ if (!int_or_boz_check (shift, 2))
return false;
+ if (shift->ts.type == BT_BOZ)
+ gfc_boz2int (shift, i);
+
+ /* shift shall be nonnegative and less than or equal to BIT_SIZE(I)
+ if I is an integer; otherwise, it shall be less than or equal to
+ BIT_SIZE(J). */
+
if (!nonnegative_check ("SHIFT", shift))
return false;
- if (i->is_boz)
+ if (i->ts.type == BT_BOZ)
{
if (!less_than_bitsize1 ("J", j, "SHIFT", shift, true))
return false;
- i->ts.kind = j->ts.kind;
}
- else
+ else
{
if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true))
return false;
- j->ts.kind = i->ts.kind;
}
return true;
@@ -2361,18 +2476,27 @@ gfc_check_i (gfc_expr *i)
bool
-gfc_check_iand (gfc_expr *i, gfc_expr *j)
+gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
{
- if (!type_check (i, 0, BT_INTEGER))
+ if (!int_or_boz_check (i, 0))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ if (!int_or_boz_check (j, 1))
return false;
+ if (!boz_args_check (i, j))
+ return false;
+
+ if (i->ts.type == BT_BOZ)
+ gfc_boz2int (i, j);
+
+ if (j->ts.type == BT_BOZ)
+ gfc_boz2int (j, i);
+
if (i->ts.kind != j->ts.kind)
{
- if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
- &i->where))
+ gfc_error ("Arguments of %qs have different kind type parameters "
+ "at %L", gfc_current_intrinsic, &i->where);
return false;
}
@@ -2487,26 +2611,6 @@ gfc_check_idnint (gfc_expr *a)
bool
-gfc_check_ieor (gfc_expr *i, gfc_expr *j)
-{
- 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)
- {
- if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
- &i->where))
- return false;
- }
-
- return true;
-}
-
-
-bool
gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
gfc_expr *kind)
{
@@ -2540,7 +2644,7 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring
bool
gfc_check_int (gfc_expr *x, gfc_expr *kind)
{
- if (!numeric_check (x, 0))
+ if (!numeric_or_boz_check (x, 0))
return false;
if (!kind_check (kind, 1, BT_INTEGER))
@@ -2559,28 +2663,7 @@ gfc_check_intconv (gfc_expr *x)
return true;
}
-
bool
-gfc_check_ior (gfc_expr *i, gfc_expr *j)
-{
- 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)
- {
- if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
- &i->where))
- return false;
- }
-
- return true;
-}
-
-
-bool
gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
{
if (!type_check (i, 0, BT_INTEGER)
@@ -3358,21 +3441,45 @@ 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))
+ if (!int_or_boz_check (i, 0))
return false;
- if (!type_check (j, 1, BT_INTEGER))
+ if (!int_or_boz_check (j, 1))
return false;
- if (!type_check (mask, 2, BT_INTEGER))
+ if (!boz_args_check (i, j))
return false;
- if (!same_type_check (i, 0, j, 1))
+ if (!int_or_boz_check (mask, 2))
return false;
- if (!same_type_check (i, 0, mask, 2))
- return false;
+ if (i->ts.type == BT_BOZ)
+ {
+ gfc_boz2int (i, j);
+ if (mask->ts.type == BT_BOZ)
+ gfc_boz2int (mask, j);
+ else if (!same_type_check (j, 0, mask, 2))
+ return false;
+ }
+ else if (j->ts.type == BT_BOZ)
+ {
+ gfc_boz2int (j, i);
+ if (mask->ts.type == BT_BOZ)
+ gfc_boz2int (mask, i);
+ else if (!same_type_check (i, 0, mask, 2))
+ return false;
+ }
+ else
+ {
+ if (!same_type_check (i, 0, j, 1))
+ return false;
+ if (mask->ts.type == BT_BOZ)
+ gfc_boz2int (mask, i);
+ else if (!same_type_check (i, 0, mask, 2))
+ return false;
+ }
+
return true;
}
@@ -3774,7 +3881,10 @@ gfc_check_rank (gfc_expr *a)
bool
gfc_check_real (gfc_expr *a, gfc_expr *kind)
{
- if (!numeric_check (a, 0))
+ if (a->ts.type == BT_BOZ)
+ return true;
+
+ if (!numeric_or_boz_check (a, 0))
return false;
if (!kind_check (kind, 1, BT_REAL))
@@ -6430,21 +6540,34 @@ 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)
+ if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL
+ && i->ts.type != BT_BOZ)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
- "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
+ "or LOGICAL or a boz-literal-constant",
+ gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &i->where);
return false;
}
- if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
+ if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL
+ && j->ts.type != BT_BOZ)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
- "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
+ "or LOGICAL or a boz-literal-constant",
+ gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &j->where);
return false;
}
+
+ if (!boz_args_check (i, j))
+ return false;
+
+ if (i->ts.type == BT_BOZ)
+ gfc_boz2int (i, j);
+
+ if (j->ts.type == BT_BOZ)
+ gfc_boz2int (j, i);
if (i->ts.type != j->ts.type)
{
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c (revision 253236)
+++ gcc/fortran/data.c (working copy)
@@ -508,9 +508,33 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rva
return false;
}
- expr = gfc_copy_expr (rvalue);
- if (!gfc_compare_types (&lvalue->ts, &expr->ts))
- gfc_convert_type (expr, &lvalue->ts, 0);
+ if (rvalue->ts.type == BT_BOZ)
+ {
+ char *t;
+ int radix;
+
+ if (lvalue->ts.type != BT_INTEGER)
+ {
+ gfc_error ("data-stmt-object at %L must be of type INTEGER",
+ &lvalue->where);
+ return false;
+ }
+
+ t = rvalue->boz;
+ radix = 16;
+ if (*t == 'b') radix = 2;
+ if (*t++ == 'o') radix = 8;
+
+ expr = gfc_get_constant_expr (BT_INTEGER, lvalue->ts.kind,
+ &lvalue->where);
+ mpz_set_str (expr->value.integer, t, radix);
+ }
+ else
+ {
+ expr = gfc_copy_expr (rvalue);
+ if (!gfc_compare_types (&lvalue->ts, &expr->ts))
+ gfc_convert_type (expr, &lvalue->ts, 0);
+ }
}
if (last_con == NULL)
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 253236)
+++ gcc/fortran/expr.c (working copy)
@@ -50,6 +50,7 @@ gfc_get_expr (void)
e->shape = NULL;
e->ref = NULL;
e->symtree = NULL;
+ e->boz = NULL;
return e;
}
@@ -333,6 +334,7 @@ gfc_copy_expr (gfc_expr *p)
}
break;
+ case BT_BOZ:
case BT_HOLLERITH:
case BT_LOGICAL:
case_bt_struct:
@@ -453,6 +455,10 @@ free_expr0 (gfc_expr *e)
mpc_clear (e->value.complex);
break;
+ case BT_BOZ:
+ free (e->boz);
+ break;
+
default:
break;
}
@@ -3282,45 +3288,55 @@ 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 (lvalue->ts.type != BT_INTEGER)
{
- 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;
+ 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;
+ }
}
+ else
+ {
+ gfc_boz2int(rvalue, lvalue);
+ return true;
+ }
}
if (gfc_expr_attr (lvalue).pdt_kind || gfc_expr_attr (lvalue).pdt_len)
@@ -3344,6 +3360,9 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue,
return true;
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
+ return true;
+
+ if (lvalue->ts.type == BT_INTEGER && rvalue->ts.type == BT_BOZ)
return true;
gfc_error ("Incompatible types in DATA statement at %L; attempted "
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 253236)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2113,10 +2113,12 @@ 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;
+ /* The BOZ string with either a 'b', 'o', and 'z' prefix. */
+ char *boz;
+
/* Sometimes, when an error has been emitted, it is necessary to prevent
it from recurring. */
unsigned int error : 1;
@@ -3360,6 +3362,7 @@ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
/* check.c */
+void gfc_boz2int (gfc_expr *, gfc_expr *);
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*);
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 253236)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -1970,8 +1970,9 @@ add_functions (void)
make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
- add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
- gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
+ add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
+ GFC_STD_F95,
+ gfc_check_iand_ieor_ior, gfc_simplify_iand, gfc_resolve_iand,
i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
if (flag_dec_intrinsic_ints)
@@ -2059,8 +2060,9 @@ add_functions (void)
make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
- add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
- gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
+ add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
+ GFC_STD_F95,
+ gfc_check_iand_ieor_ior, gfc_simplify_ieor, gfc_resolve_ieor,
i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
if (flag_dec_intrinsic_ints)
@@ -2137,8 +2139,9 @@ add_functions (void)
make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
- add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
- gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
+ add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
+ GFC_STD_F95,
+ gfc_check_iand_ieor_ior, gfc_simplify_ior, gfc_resolve_ior,
i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
if (flag_dec_intrinsic_ints)
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h (revision 253236)
+++ gcc/fortran/intrinsic.h (working copy)
@@ -87,17 +87,15 @@ bool gfc_check_hostnm (gfc_expr *);
bool gfc_check_huge (gfc_expr *);
bool gfc_check_hypot (gfc_expr *, gfc_expr *);
bool gfc_check_i (gfc_expr *);
-bool gfc_check_iand (gfc_expr *, gfc_expr *);
+bool gfc_check_iand_ieor_ior (gfc_expr *, gfc_expr *);
bool gfc_check_and (gfc_expr *, gfc_expr *);
bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
bool gfc_check_idnint (gfc_expr *);
-bool gfc_check_ieor (gfc_expr *, gfc_expr *);
bool gfc_check_image_status (gfc_expr *, gfc_expr *);
bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_int (gfc_expr *, gfc_expr *);
bool gfc_check_intconv (gfc_expr *);
-bool gfc_check_ior (gfc_expr *, gfc_expr *);
bool gfc_check_irand (gfc_expr *);
bool gfc_check_isatty (gfc_expr *);
bool gfc_check_isnan (gfc_expr *);
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi (revision 253236)
+++ gcc/fortran/intrinsic.texi (working copy)
@@ -1142,15 +1142,20 @@ Function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
-type or a scalar @code{LOGICAL} type.
-@item @var{J} @tab The type shall be the same as the type of @var{I}.
+type or a scalar @code{LOGICAL} type or a boz-literal-constant.
+@item @var{J} @tab The type shall be the same as the type of @var{I} or
+a boz-literal-constant. @var{I} and @var{J} shall not both be
+boz-literal-constants. If either @var{I} or @var{J} is a
+boz-literal-constant, then the other argument must be a scalar @code{INTEGER}.
@end multitable
@item @emph{Return value}:
The return type is either a scalar @code{INTEGER} or a scalar
@code{LOGICAL}. If the kind type parameters differ, then the
smaller kind type is implicitly converted to larger kind, and the
-return has the larger kind.
+return has the larger kind. A boz-literal-constant is
+converted to an @code{INTEGER} with the kind type parameter of
+the other argument as-if a call to @ref{INT} occurred.
@item @emph{Example}:
@smallexample
@@ -7461,16 +7466,17 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{I} @tab The type shall be @code{INTEGER}.
-@item @var{J} @tab The type shall be @code{INTEGER}, of the same
-kind as @var{I}. (As a GNU extension, different kinds are also
-permitted.)
+@item @var{I} @tab The type shall be @code{INTEGER} or a boz-literal-constant.
+@item @var{J} @tab The type shall be @code{INTEGER} with the same
+kind type parameter as @var{I} or a boz-literal-constant.
+@var{I} and @var{J} shall not both be boz-literal-constants.
@end multitable
@item @emph{Return value}:
-The return type is @code{INTEGER}, of the same kind as the
-arguments. (If the argument kinds differ, it is of the same kind as
-the larger argument.)
+The return type is @code{INTEGER} with the kind type parameter of the
+arguments.
+A boz-literal-constant is converted to an @code{INTEGER} with the kind
+type parameter of the other argument as-if a call to @ref{INT} occurred.
@item @emph{Example}:
@smallexample
@@ -7911,16 +7917,17 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{I} @tab The type shall be @code{INTEGER}.
-@item @var{J} @tab The type shall be @code{INTEGER}, of the same
-kind as @var{I}. (As a GNU extension, different kinds are also
-permitted.)
+@item @var{I} @tab The type shall be @code{INTEGER} or a boz-literal-constant.
+@item @var{J} @tab The type shall be @code{INTEGER} with the same
+kind type parameter as @var{I} or a boz-literal-constant.
+@var{I} and @var{J} shall not both be boz-literal-constants.
@end multitable
@item @emph{Return value}:
-The return type is @code{INTEGER}, of the same kind as the
-arguments. (If the argument kinds differ, it is of the same kind as
-the larger argument.)
+The return type is @code{INTEGER} with the kind type parameter of the
+arguments.
+A boz-literal-constant is converted to an @code{INTEGER} with the kind
+type parameter of the other argument as-if a call to @ref{INT} occurred.
@item @emph{Specific names}:
@multitable @columnfractions .20 .20 .20 .25
@@ -8229,16 +8236,17 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{I} @tab The type shall be @code{INTEGER}.
-@item @var{J} @tab The type shall be @code{INTEGER}, of the same
-kind as @var{I}. (As a GNU extension, different kinds are also
-permitted.)
+@item @var{I} @tab The type shall be @code{INTEGER} or a boz-literal-constant.
+@item @var{J} @tab The type shall be @code{INTEGER} with the same
+kind type parameter as @var{I} or a boz-literal-constant.
+@var{I} and @var{J} shall not both be boz-literal-constants.
@end multitable
@item @emph{Return value}:
-The return type is @code{INTEGER}, of the same kind as the
-arguments. (If the argument kinds differ, it is of the same kind as
-the larger argument.)
+The return type is @code{INTEGER} with the kind type parameter of the
+arguments.
+A boz-literal-constant is converted to an @code{INTEGER} with the kind
+type parameter of the other argument as-if a call to @ref{INT} occurred.
@item @emph{Specific names}:
@multitable @columnfractions .20 .20 .20 .25
@@ -10225,11 +10233,12 @@ Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{I} @tab Shall be of type @code{INTEGER}.
-@item @var{J} @tab Shall be of type @code{INTEGER} and of the same
-kind as @var{I}.
-@item @var{MASK} @tab Shall be of type @code{INTEGER} and of the same
-kind as @var{I}.
+@item @var{I} @tab Shall be of type @code{INTEGER} or a boz-literal-constant.
+@item @var{J} @tab Shall be of type @code{INTEGER} with the same
+kind type parameter as @var{I} or a boz-literal-constant.
+@var{I} and @var{J} shall not both be boz-literal-constants.
+@item @var{MASK} @tab Shall be of type @code{INTEGER} or a boz-literal-constant
+and of the same kind as @var{I}.
@end multitable
@item @emph{Return value}:
@@ -11046,15 +11055,20 @@ Function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
-type or a scalar @code{LOGICAL} type.
-@item @var{J} @tab The type shall be the same as the type of @var{J}.
+type or a scalar @code{LOGICAL} type or a boz-literal-constant.
+@item @var{J} @tab The type shall be the same as the type of @var{I} or
+a boz-literal-constant. @var{I} and @var{J} shall not both be
+boz-literal-constants. If either @var{I} and @var{J} is a
+boz-literal-constant, then the other argument must be a scalar @code{INTEGER}.
@end multitable
@item @emph{Return value}:
The return type is either a scalar @code{INTEGER} or a scalar
@code{LOGICAL}. If the kind type parameters differ, then the
smaller kind type is implicitly converted to larger kind, and the
-return has the larger kind.
+return has the larger kind. A boz-literal-constant is
+converted to an @code{INTEGER} with the kind type parameter of
+the other argument as-if a call to @ref{INT} occurred.
@item @emph{Example}:
@smallexample
@@ -14506,16 +14520,21 @@ Function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
-type or a scalar @code{LOGICAL} type.
-@item @var{J} @tab The type shall be the same as the type of @var{I}.
+@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
+type or a scalar @code{LOGICAL} type or a boz-literal-constant.
+@item @var{J} @tab The type shall be the same as the type of @var{I} or
+a boz-literal-constant. @var{I} and @var{J} shall not both be
+boz-literal-constants. If either @var{I} and @var{J} is a
+boz-literal-constant, then the other argument must be a scalar @code{INTEGER}.
@end multitable
@item @emph{Return value}:
The return type is either a scalar @code{INTEGER} or a scalar
@code{LOGICAL}. If the kind type parameters differ, then the
smaller kind type is implicitly converted to larger kind, and the
-return has the larger kind.
+return has the larger kind. A boz-literal-constant is
+converted to an @code{INTEGER} with the kind type parameter of
+the other argument as-if a call to @ref{INT} occurred.
@item @emph{Example}:
@smallexample
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 253236)
+++ gcc/fortran/iresolve.c (working copy)
@@ -1222,19 +1222,8 @@ gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_ex
void
-gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED)
{
- /* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
- kinds to match. */
- if (i->ts.kind != j->ts.kind)
- {
- if (i->ts.kind == gfc_kind_max (i, j))
- gfc_convert_type (j, &i->ts, 2);
- else
- gfc_convert_type (i, &j->ts, 2);
- }
-
f->ts = i->ts;
f->value.function.name = gfc_get_string ("__iand_%d", i->ts.kind);
}
@@ -1313,38 +1302,16 @@ gfc_resolve_ierrno (gfc_expr *f)
void
-gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED)
{
- /* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
- kinds to match. */
- if (i->ts.kind != j->ts.kind)
- {
- if (i->ts.kind == gfc_kind_max (i, j))
- gfc_convert_type (j, &i->ts, 2);
- else
- gfc_convert_type (i, &j->ts, 2);
- }
-
f->ts = i->ts;
f->value.function.name = gfc_get_string ("__ieor_%d", i->ts.kind);
}
void
-gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED)
{
- /* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
- kinds to match. */
- if (i->ts.kind != j->ts.kind)
- {
- if (i->ts.kind == gfc_kind_max (i, j))
- gfc_convert_type (j, &i->ts, 2);
- else
- gfc_convert_type (i, &j->ts, 2);
- }
-
f->ts = i->ts;
f->value.function.name = gfc_get_string ("__ior_%d", i->ts.kind);
}
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (revision 253236)
+++ gcc/fortran/libgfortran.h (working copy)
@@ -159,12 +159,12 @@ typedef enum
#define GFC_DTYPE_TYPE_MASK 0x38
#define GFC_DTYPE_SIZE_SHIFT 6
-/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
+/* Basic types. BT_VOID is used by ISO C Binding so functions like c_f_pointer
can take any arg with the pointer attribute as a param. These are also
used in the run-time library for IO. */
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/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 253236)
+++ gcc/fortran/primary.c (working copy)
@@ -328,16 +328,16 @@ cleanup:
}
-/* Match a binary, octal or hexadecimal constant that can be found in
- a DATA statement. The standard permits b'010...', o'73...', and
- z'a1...' where b, o, and z can be capital letters. This function
- also accepts postfixed forms of the constants: '01...'b, '73...'o,
- and 'a1...'z. An additional extension is the use of x for z. */
+/* Match a binary, octal or hexadecimal constant. The standard permits
+ b'010...', o'73...', and z'a1...' where b, o, and z can be capital
+ letters. This function also accepts postfixed forms of the constants:
+ '01...'b, '73...'o, and 'a1...'z. An additional extension is the use
+ of x for z. */
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;
@@ -443,18 +443,16 @@ match_boz_constant (gfc_expr **result)
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;
- }
+ /* Save the BOZ with an appropriate prefix, e.g., b1001011. */
+ e = gfc_get_constant_expr (BT_BOZ, -1, &gfc_current_locus);
+ e->boz = XCNEWVEC (char, length + 2);
+ if (radix == 2)
+ strcpy (e->boz, "b");
+ else if (radix == 8)
+ strcpy (e->boz, "o");
+ else
+ strcpy (e->boz, "z");
+ strcat (e->boz, buffer);
if (!gfc_in_match_data ()
&& (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 253236)
+++ gcc/fortran/resolve.c (working copy)
@@ -3776,6 +3776,31 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
case INTRINSIC_POWER:
+
+ if (op1->ts.type == BT_BOZ && op2->ts.type == BT_BOZ)
+ {
+ gfc_error ("Operands at %L and %L of intrinsic operator %qs cannot "
+ "both be boz-literal-constants", &op1->where, &op2->where,
+ gfc_op2string (e->value.op.op));
+ return false;
+ }
+
+ if (op1->ts.type == BT_BOZ)
+ {
+ if (op2->ts.type == BT_INTEGER)
+ gfc_boz2int (op1, op2);
+ else
+ gfc_convert_boz (op1, &op2->ts);
+ }
+
+ if (op2->ts.type == BT_BOZ)
+ {
+ if (op1->ts.type == BT_INTEGER)
+ gfc_boz2int (op2, op1);
+ else
+ gfc_convert_boz (op2, &op1->ts);
+ }
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -3886,6 +3911,30 @@ resolve_operator (gfc_expr *e)
break;
}
+ if (op1->ts.type == BT_BOZ && op2->ts.type == BT_BOZ)
+ {
+ gfc_error ("Operands of comparison operator %qs at %L cannot both be "
+ "boz-literal-constants", gfc_op2string (e->value.op.op),
+ &op2->where);
+ return false;
+ }
+
+ if (op1->ts.type == BT_BOZ)
+ {
+ if (op2->ts.type == BT_INTEGER)
+ gfc_boz2int (op1, op2);
+ else
+ gfc_convert_boz (op1, &op2->ts);
+ }
+
+ if (op2->ts.type == BT_BOZ)
+ {
+ if (op1->ts.type == BT_INTEGER)
+ gfc_boz2int (op2, op1);
+ else
+ gfc_convert_boz (op2, &op1->ts);
+ }
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -7387,8 +7436,14 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bo
if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred
&& !UNLIMITED_POLY (e))
{
- int cmp = gfc_dep_compare_expr (e->ts.u.cl->length,
- code->ext.alloc.ts.u.cl->length);
+ int cmp;
+
+ if (!e->ts.u.cl->length)
+ goto failure;
+
+ cmp = gfc_dep_compare_expr (e->ts.u.cl->length,
+ code->ext.alloc.ts.u.cl->length);
+
if (cmp == 1 || cmp == -1 || cmp == -3)
{
gfc_error ("Allocating %s at %L with type-spec requires the same "
@@ -10059,14 +10114,14 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace
lhs = code->expr1;
rhs = code->expr2;
- if (rhs->is_boz
+ if (rhs->ts.type == BT_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 && lhs->ts.type != BT_INTEGER)
{
int rc;
if (warn_surprising)
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 253236)
+++ gcc/fortran/simplify.c (working copy)
@@ -212,7 +212,7 @@ gfc_convert_mpz_to_signed (mpz_t x, int bitsize)
static gfc_expr *
convert_boz (gfc_expr *x, int kind)
{
- if (x && x->ts.type == BT_INTEGER && x->is_boz)
+ if (x && x->ts.type == BT_BOZ)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
@@ -1614,14 +1614,21 @@ 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 x is a BOZ at this point, then convert it. */
+ if (x->expr_type == EXPR_CONSTANT)
+ {
+ 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 y is a BOZ at this point, then convert it. */
+ if (y && y->expr_type == EXPR_CONSTANT)
+ {
+ 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))
+ if (x->expr_type != EXPR_CONSTANT || (y && y->expr_type != EXPR_CONSTANT))
return NULL;
result = gfc_get_constant_expr (BT_COMPLEX, kind, &x->where);
@@ -1685,7 +1692,21 @@ gfc_simplify_complex (gfc_expr *x, gfc_expr *y)
{
int kind;
- if (x->ts.type == BT_INTEGER && y->ts.type == BT_INTEGER)
+ if (x->ts.type == BT_BOZ)
+ {
+ if (y->ts.type == BT_BOZ || y->ts.type == BT_INTEGER)
+ kind = gfc_default_complex_kind;
+ else
+ kind = y->ts.kind;
+ }
+ else if (y->ts.type == BT_BOZ)
+ {
+ if (x->ts.type == BT_BOZ || x->ts.type == BT_INTEGER)
+ kind = gfc_default_complex_kind;
+ else
+ kind = x->ts.kind;
+ }
+ else if (x->ts.type == BT_INTEGER && y->ts.type == BT_INTEGER)
kind = gfc_default_complex_kind;
else if (x->ts.type == BT_REAL || y->ts.type == BT_INTEGER)
kind = x->ts.kind;
@@ -2504,7 +2525,7 @@ gfc_simplify_float (gfc_expr *a)
if (a->expr_type != EXPR_CONSTANT)
return NULL;
- if (a->is_boz)
+ if (a->ts.type == BT_BOZ)
{
if (convert_boz (a, gfc_default_real_kind) == &gfc_bad_expr)
return &gfc_bad_expr;
@@ -3151,6 +3172,19 @@ simplify_intconv (gfc_expr *e, int kind, const char *n
if (e->expr_type != EXPR_CONSTANT)
return NULL;
+
+ if (e->ts.type == BT_BOZ)
+ {
+ char *t;
+ int radix;
+ t = e->boz;
+ radix = 16;
+ if (*t == 'b') radix = 2;
+ if (*t++ == 'o') radix = 8;
+ e->ts.type = BT_INTEGER;
+ mpz_init (e->value.integer);
+ mpz_set_str (e->value.integer, t, radix);
+ }
result = gfc_convert_constant (e, BT_INTEGER, kind);
if (result == &gfc_bad_expr)
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c (revision 253236)
+++ gcc/fortran/target-memory.c (working copy)
@@ -735,7 +735,27 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e,
return len;
}
+/* boz2int implements the old semantics of converting a boz to an
+ integer with the largest kind value. This is a kludge until one
+ determines if gfc_convert_boz can use e->boz directly. */
+static void
+boz2int (gfc_expr *i)
+{
+ char *t;
+ int radix;
+
+ t = i->boz;
+ radix = 16;
+ if (*t == 'b') radix = 2;
+ if (*t++ == 'o') radix = 8;
+
+ i->ts.kind = gfc_max_integer_kind;
+ mpz_init (i->value.integer);
+ mpz_set_str (i->value.integer, t, radix);
+}
+
+
/* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
When successful, no BOZ or nothing to do, true is returned. */
@@ -746,12 +766,11 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
int index;
unsigned char *buffer;
- if (!expr->is_boz)
+ gcc_assert (expr->expr_type == EXPR_CONSTANT);
+
+ if (expr->ts.type != BT_BOZ)
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)
{
@@ -766,7 +785,9 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
else
return true;
+
/* Convert BOZ to the smallest possible integer kind. */
+ boz2int (expr);
boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
if (boz_bit_size > ts_bit_size)
@@ -798,7 +819,6 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
gfc_interpret_complex (ts->kind, buffer, buffer_size,
expr->value.complex);
}
- expr->is_boz = 0;
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 253236)
+++ 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/boz_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_4.f90 (revision 253236)
+++ gcc/testsuite/gfortran.dg/boz_4.f90 (nonexistent)
@@ -1,29 +0,0 @@
-! { dg-do compile }
-! Test that the conversion of a BOZ constant that is too large for the
-! integer variable is caught by the compiler.
-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(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" }
-
-end program boz
Index: gcc/testsuite/gfortran.dg/graphite/id-26.f03
===================================================================
--- gcc/testsuite/gfortran.dg/graphite/id-26.f03 (revision 253236)
+++ gcc/testsuite/gfortran.dg/graphite/id-26.f03 (working copy)
@@ -51,11 +51,11 @@
! Attempt to create 64-byte aligned allocatable
do i = 1, 64
allocate (c(1023 + i))
- if (iand (loc (c(1)), 63) == 0) exit
+ if (iand(int(loc(c(1)), 8), 63_8) == 0) exit
deallocate (c)
allocate (b(i)%a(1023 + i))
allocate (c(1023 + i))
- if (iand (loc (c(1)), 63) == 0) exit
+ if (iand(int(loc(c(1)), 8), 63_8) == 0) exit
deallocate (c)
end do
if (allocated (c)) then
Index: gcc/testsuite/gfortran.dg/pr81509_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr81509_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr81509_1.f90 (working copy)
@@ -0,0 +1,12 @@
+! { dg-do run }
+! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=81509
+program foo
+logical :: a = .false.
+integer :: i = 42
+integer(8) :: k = 42
+if (kind(ieor(z'ade',i)) /= 4) call abort
+if (kind(ior(i,z'1111')) /= 4) call abort
+if (kind(ior(1_8,k)) /= 8) call abort
+if (kind(iand(k,b'1111')) /= 8) call abort
+end program foo
+
Index: gcc/testsuite/gfortran.dg/pr81509_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr81509_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr81509_2.f90 (working copy)
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=81509
+!
+program foo
+logical :: a = .false.
+integer :: i = 42
+integer(8) :: k
+k = iand(z'aaaa', z'1234') ! { dg-error "cannot both be BOZ literal" }
+k = and(z'aaaa', z'1234') ! { dg-error "cannot both be BOZ literal" }
+k = and(1, z'1234')
+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" }
+end program foo
+
Index: gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 (revision 253236)
+++ gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 (working copy)
@@ -6,6 +6,11 @@ program main
integer(kind=1) :: b(8)
integer(kind=8) :: j
+ integer(1), parameter :: b1 = z'11', b2 = z'22', b3 = z'33', b4 = z'44', b5 = z'55', &
+ & b6 = z'66', b7 = z'77', b8 = z'00' ! { dg-warning "BOZ literal" }
+
+ integer(4), parameter :: i1 = z'11223344', i2 = z'55667700' ! { dg-warning "BOZ literal" }
+
c = (3.14, 2.71)
open (10, form="unformatted",convert="swap") ! { dg-warning "Extension: CONVERT" }
write (10) c
@@ -15,11 +20,11 @@ program main
close(10,status="delete")
open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
- i = (/ Z'11223344', Z'55667700' /)
+ i = (/ i1, i2 /)
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 /= (/ b1, b2, b3, b4, b5, b6, b7, b8 /))) &
call abort
backspace 10
read (10) j
@@ -30,7 +35,7 @@ program main
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 /= (/ b4, b3, b2, b1, b8, b7, b6, b5 /))) &
call abort
backspace 10
read (10) j
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
2017-10-06 20:34 [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015 Steve Kargl
@ 2017-10-07 4:30 ` Jerry DeLisle
2017-10-07 4:51 ` Steve Kargl
0 siblings, 1 reply; 7+ messages in thread
From: Jerry DeLisle @ 2017-10-07 4:30 UTC (permalink / raw)
To: sgk, fortran, gcc-patches
On 10/06/2017 01:34 PM, Steve Kargl wrote:
> All,
>
> I have spent the last few days trying to reconcile the various Fortran
> standards' requirements for handling BOZ. The short story is that J3
> over the last 27 years has made incompatible changes to the interpretation
> of a BOZ (under some circumstances). The interpretations in F2008 and
> F2015 now treat a boz-literal-constant as a sequence of bits. Unfortunately,
> due to quirks in how BOZ are currently implemented in gfortran and a boat
> load of documented and undocumented extensions, bringing gfortran into
> agreement with F2008/F2015 led to a rewrite of BOZ handling. In the
> rewrite I have made no attempt to use the -std= option to try to maintain
> the incompatibilities between standards.
>
The patch tests OK on trunk with linux-x86_64. I suggest this be committed as is
and then see if there is any fallout that can be dealt with -std=legacy or
similar later.
Regards,
Jerry
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
2017-10-07 4:30 ` Jerry DeLisle
@ 2017-10-07 4:51 ` Steve Kargl
0 siblings, 0 replies; 7+ messages in thread
From: Steve Kargl @ 2017-10-07 4:51 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: fortran, gcc-patches
On Fri, Oct 06, 2017 at 09:30:06PM -0700, Jerry DeLisle wrote:
> On 10/06/2017 01:34 PM, Steve Kargl wrote:
> > All,
> >
> > I have spent the last few days trying to reconcile the various Fortran
> > standards' requirements for handling BOZ. The short story is that J3
> > over the last 27 years has made incompatible changes to the interpretation
> > of a BOZ (under some circumstances). The interpretations in F2008 and
> > F2015 now treat a boz-literal-constant as a sequence of bits. Unfortunately,
> > due to quirks in how BOZ are currently implemented in gfortran and a boat
> > load of documented and undocumented extensions, bringing gfortran into
> > agreement with F2008/F2015 led to a rewrite of BOZ handling. In the
> > rewrite I have made no attempt to use the -std= option to try to maintain
> > the incompatibilities between standards.
> >
>
> The patch tests OK on trunk with linux-x86_64. I suggest this be
> committed as is and then see if there is any fallout that can be
> dealt with -std=legacy or similar later.
>
Thanks, but unfortunately in my review of the patch and F2008/F2015
found an issue.
integer :: i = int(z'123456789',4)
isn't handled correctly. We do get a silly error.
% gfcx -c a.f90
a.f90:1:19:
integer :: i = int(z'123456789',4)
1
Error: Arithmetic overflow converting INTEGER(-1) to INTEGER(4) at (1).
This check can be disabled with the option '-fno-range-check'
F2008 13.3.3 has
When a boz-literal-constant is the argument A of the intrinsic
function INT or REAL,
...
if the length of the sequence of bits specified by A is greater
than the size in bits of a scalar variable of the same type and
kind type parameter as the result, the boz-literal-constant is
treated as if it were truncated from the left to a length equal
to the size in bits of the result.
C1301 If a boz-literal-constant is truncated as an argument to
the intrinsic function REAL, the discarded bits shall all be zero.
We handle C1301 correctly except the error message could be better.
% gfcx -c a.f90
a.f90:1:17:
real :: i = real(z'123456789',4)
1
Error: BOZ constant at (1) is too large (33 vs 32 bits)
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
2017-10-09 16:48 ` Dominique d'Humières
@ 2017-10-09 18:19 ` Steve Kargl
0 siblings, 0 replies; 7+ messages in thread
From: Steve Kargl @ 2017-10-09 18:19 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: gfortran, gcc-patches
On Mon, Oct 09, 2017 at 06:48:33PM +0200, Dominique d'Humières wrote:
>
> > Le 7 oct. 2017 à 17:48, Steve Kargl <sgk@troutmask.apl.washington.edu> a écrit :
> >
> > On Sat, Oct 07, 2017 at 12:37:03PM +0200, Dominique d'Humières wrote:
> >> (4) Compiling
> >>
> >> print *, INT(z'ffffffff',4)
> >> end
> >>
> >> gives
> >>
> >> print *, INT(z'ffffffff',4)
> >> 1
> >> Error: Arithmetic overflow converting INTEGER(-1) to INTEGER(4)
> >> at (1). This check can be disabled with the option '-fno-range-check’
> >>
> >> Should not it be -1?
> >
> > Maybe. :-)
> >
> > See my note to Jerry about needing to implement F2015 16.3.3 correctly.
> > Upon sleeping on this deficiency, I realized that 16.3.3 without stating
> > allows one to set the sign-bit. We find in 16.3.1 the statement
>
> s/16/13/?
Yes. F2008 is 13. F2015 is 16.
> >
> > The interpretation of a negative integer as a sequence of bits
> > is processor dependent.
> >
> > There is the bit model and integer model numbers. F2015 contrasts the
> > models and concludes with
> >
> > In particular, whereas the models are identical for r = 2 and
> > $w_{z-1}$ = 0, they do not correspond for r = 2 or $w_{z-1} = 1$
> > and the interpretation of bits in such objects is processor dependent.
>
> I am not sure this is relevant. The problem here is not about bit
> interpretation, but how you fill 32 bits with a 32-bit pattern.
>
> IMO 'INT(z'ffffffff',4)' should return an integer(4) with all its
> bits set to one.
Yes, of course, but one of those bits is a sign-bit. What gfortran
does at the moment is take a boz, converts it to an mpz_t entity
and sets the kind to gfc_max_integer_kind. The mpz_t entity is
nonnegative. When the boz is used in the context of an INTEGER,
gfortran does a conversion (if necessary), and then typically calls
range_check(). gfortran will issue an error. However, because
the interpretation of a sing-bit is processori dependent, the error
is not needed nor desired for under F2008 and F2015. Likewise, I
think the error can be removed for nan = real(z'fffffff',4).
>
> (7) libgomp/testsuite/libgomp.fortran/aligned1.f03 should be changed as gcc/testsuite/gfortran.dg/graphite/id-26.f03:
>
> --- ../_clean/libgomp/testsuite/libgomp.fortran/aligned1.f03 2017-09-28 11:35:02.000000000 +0200
> +++ libgomp/testsuite/libgomp.fortran/aligned1.f03 2017-10-09 18:29:25.000000000 +0200
> @@ -52,11 +52,11 @@
> ! Attempt to create 64-byte aligned allocatable
> do i = 1, 64
> allocate (c(1023 + i))
> - if (iand (loc (c(1)), 63) == 0) exit
> + if (iand (int(loc (c(1)), 8), 63_8) == 0) exit
> deallocate (c)
> allocate (b(i)%a(1023 + i))
> allocate (c(1023 + i))
> - if (iand (loc (c(1)), 63) == 0) exit
> + if (iand (int(loc (c(1)), 8), 63_8) == 0) exit
> deallocate (c)
> end do
> if (allocated (c)) then
>
> otherwise it fails with -m64.
I don't use -m32 and -m64. Using these options with the testsuite
is silly. Once, my patch hits the tree if this failure is still
present, then you can fix it with
if (iand (int(loc (c(1)), kind(63)), 63) == 0) exit
Note, loc() returns an integer with a kind defined by
gfc_index_integer_kind = get_int_kind_from_name (PTRDIFF_TYPE);
I'm not surprised that PTRDIFF_TYPE may change depending of the
underlying pointer type.
> (8) In gfortran.dg/unf_io_convert_2.f90, why is
>
> integer(1), parameter :: b1 = z'11’, …
This is a GNU Fortran extension. I retained the extension
as I worked on the patch. b1 is a named constant, and the
rhs side is an initialization expression that reduces to a
constant. Here, the constant is a boz and one can easily
grab the type and kind from the LHS. Note, this patch isn't
strictly needed any longer, because I've found a way to allow
a BOZ to be used in an array constructor (another dubious
extension).
>
> valid, but not
>
> integer(1) :: b1
> b1 = z’11’
>
GNU Fortran has a dubious extension that allows a BOZ in
an expression. This may be an accident from my ~13 year
old decision (primary -r95643) to convert a boz to
integer(gfc_max_integer_kind) when a boz is matched. A boz
is a typeless and kindless entity (in F2008 and F2015). The
RHS of an expression is evaluated without reference to the LHS.
What type and kind should be used for z'11'. For
b1 = z'11' + 0
I allow mixed-mode math to convert z'11' to the type and kind
of 0. This expression is basically b1 = int(int(z'11',kind(0))+0,kind(b1)).
If we want to retain the extension the resolve.c probably
needs an update to handle UNARY_PLUS and UNARY_MINUS.
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
2017-10-07 15:48 ` Steve Kargl
@ 2017-10-09 16:48 ` Dominique d'Humières
2017-10-09 18:19 ` Steve Kargl
0 siblings, 1 reply; 7+ messages in thread
From: Dominique d'Humières @ 2017-10-09 16:48 UTC (permalink / raw)
To: sgk; +Cc: gfortran, gcc-patches
> Le 7 oct. 2017 à 17:48, Steve Kargl <sgk@troutmask.apl.washington.edu> a écrit :
>
> On Sat, Oct 07, 2017 at 12:37:03PM +0200, Dominique d'Humières wrote:
>> (4) Compiling
>>
>> print *, INT(z'ffffffff',4)
>> end
>>
>> gives
>>
>> print *, INT(z'ffffffff',4)
>> 1
>> Error: Arithmetic overflow converting INTEGER(-1) to INTEGER(4)
>> at (1). This check can be disabled with the option '-fno-range-check’
>>
>> Should not it be -1?
>
> Maybe. :-)
>
> See my note to Jerry about needing to implement F2015 16.3.3 correctly.
> Upon sleeping on this deficiency, I realized that 16.3.3 without stating
> allows one to set the sign-bit. We find in 16.3.1 the statement
s/16/13/?
>
> The interpretation of a negative integer as a sequence of bits
> is processor dependent.
>
> There is the bit model and integer model numbers. F2015 contrasts the
> models and concludes with
>
> In particular, whereas the models are identical for r = 2 and
> $w_{z-1}$ = 0, they do not correspond for r = 2 or $w_{z-1} = 1$
> and the interpretation of bits in such objects is processor dependent.
I am not sure this is relevant. The problem here is not about bit interpretation, but how you fill 32 bits with a 32-bit pattern.
IMO 'INT(z'ffffffff',4)' should return an integer(4) with all its bits set to one.
(7) libgomp/testsuite/libgomp.fortran/aligned1.f03 should be changed as gcc/testsuite/gfortran.dg/graphite/id-26.f03:
--- ../_clean/libgomp/testsuite/libgomp.fortran/aligned1.f03 2017-09-28 11:35:02.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/aligned1.f03 2017-10-09 18:29:25.000000000 +0200
@@ -52,11 +52,11 @@
! Attempt to create 64-byte aligned allocatable
do i = 1, 64
allocate (c(1023 + i))
- if (iand (loc (c(1)), 63) == 0) exit
+ if (iand (int(loc (c(1)), 8), 63_8) == 0) exit
deallocate (c)
allocate (b(i)%a(1023 + i))
allocate (c(1023 + i))
- if (iand (loc (c(1)), 63) == 0) exit
+ if (iand (int(loc (c(1)), 8), 63_8) == 0) exit
deallocate (c)
end do
if (allocated (c)) then
otherwise it fails with -m64.
(8) In gfortran.dg/unf_io_convert_2.f90, why is
integer(1), parameter :: b1 = z'11’, …
valid, but not
integer(1) :: b1
b1 = z’11’
?
Dominique
> --
> Steve
> 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
> 20161221 https://www.youtube.com/watch?v=IbCHE-hONow
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
2017-10-07 10:37 Dominique d'Humières
@ 2017-10-07 15:48 ` Steve Kargl
2017-10-09 16:48 ` Dominique d'Humières
0 siblings, 1 reply; 7+ messages in thread
From: Steve Kargl @ 2017-10-07 15:48 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: gfortran, gcc-patches
On Sat, Oct 07, 2017 at 12:37:03PM +0200, Dominique d'Humières wrote:
> (1) Typo in gcc/fortran/array.c
>
> + /* If an array contains a BT_BOZ, then array elements need to be converted
> + an INTEGER. This is an GNU Fortran extension. Mixing BOZ and non-BOZ
> missing ‘to’?
Thanks. I'll fix this
>
> (2) Compiling
>
> integer :: i = 1, j = 2
> print *, ble(i,j), blt(z'ff',z'fa')
> end
>
> gives an ICE
>
> f951: internal compiler error: in compare_bitwise, at fortran/simplify.c:1516
>
> which is
>
> gcc_assert (i->ts.type == BT_INTEGER);
> gcc_assert (j->ts.type == BT_INTEGER);
Whoops. Forgot to check the bge, blt, etc simplification routines.
>
> (3) Compiling (variant of pr54072)
>
> USE, INTRINSIC :: ISO_C_BINDING
> IMPLICIT NONE
> INTEGER, PARAMETER :: GLbitfield=C_INT
> INTEGER(GLbitfield), PARAMETER :: GL_CURRENT_BIT = INT(z'00000001') ! 0x00000001
> INTEGER(GLbitfield), PARAMETER :: GL_CLIENT_ALL_ATTRIB_BITS = &
> transfer(z'ffffffff',GL_CURRENT_BIT) ! 0xffffffff
This is nonconforming code. A BOZ cannot appear as an arg to transfer.
> print *, GLbitfield, GL_CURRENT_BIT, GL_CLIENT_ALL_ATTRIB_BITS
> END
>
> gives an ICE
>
> f951: internal compiler error: Invalid expression in gfc_element_size.
I'll need to check how we get to gfc_element size from the BOZ
in transfer.
>
> (4) Compiling
>
> print *, INT(z'ffffffff',4)
> end
>
> gives
>
> print *, INT(z'ffffffff',4)
> 1
> Error: Arithmetic overflow converting INTEGER(-1) to INTEGER(4)
> at (1). This check can be disabled with the option '-fno-range-check’
>
> Should not it be -1?
Maybe. :-)
See my note to Jerry about needing to implement F2015 16.3.3 correctly.
Upon sleeping on this deficiency, I realized that 16.3.3 without stating
allows one to set the sign-bit. We find in 16.3.1 the statement
The interpretation of a negative integer as a sequence of bits
is processor dependent.
There is the bit model and integer model numbers. F2015 contrasts the
models and concludes with
In particular, whereas the models are identical for r = 2 and
$w_{z-1}$ = 0, they do not correspond for r = 2 or $w_{z-1} = 1$
and the interpretation of bits in such objects is processor dependent.
>
> (5) Compiling
>
> print *, real(z'ffffffff',4)
> end
>
> gives
>
> print *, real(z'ffffffff',4)
> 1
> Error: Arithmetic NaN converting REAL(4) to REAL(4) at (1).i
> This check can be disabled with the option '-fno-range-check’
>
> Why not a warning?
Ask Tobias. I retained his gfc_convert_boz function. He
calls range_check() at the end. You get this error prior
to my patch.
> (6) Compiling
>
> print *, storage_size(z'FFFFFFFF')
> end
>
> gives an ICE
>
> f951: internal compiler error: Invalid expression in gfc_element_size.
>
> The code is probably invalid, but I don’t know how to parse
Nonconforming code. A BOZ cannot be an actual arg to storage_size.
In F2008/2015, a BOZ is a typeless and kindless entity.
16.9.184 STORAGE_SIZE (A [, KIND])
A shall be a data object of any type.
7.1.2 Type classification
A type is either an intrinsic type or a derived type.
This document defines five intrinsic types: integer, real, complex,
character, and logical.
A derived type is one that is defined by a derived-type definition
(7.5.2) or by an intrinsic module.
7.7 Binary, octal, and hexadecimal literal constants
A binary, octal, or hexadecimal constant (boz-literal-constant) is a
sequence of digits that represents an ordered sequence of bits. Such a
constant has no type.
>
> Without the patch it returns 128 at run time.
>
That's because 13 to 15 years, I made gfortran convert a BOZ
to INTEGER(gfc_max_integer_kind) when a BOZ was parsed. The
internal representation a BOZ is INTEGER, so storage_size
thinks it is an integer.
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015.
@ 2017-10-07 10:37 Dominique d'Humières
2017-10-07 15:48 ` Steve Kargl
0 siblings, 1 reply; 7+ messages in thread
From: Dominique d'Humières @ 2017-10-07 10:37 UTC (permalink / raw)
To: Steve Kargl; +Cc: gfortran, gcc-patches
Thanks for working on the issue. While testing your patch I have found the following problems:
(1) Typo in gcc/fortran/array.c
+ /* If an array contains a BT_BOZ, then array elements need to be converted
+ an INTEGER. This is an GNU Fortran extension. Mixing BOZ and non-BOZ
missing ‘to’?
(2) Compiling
integer :: i = 1, j = 2
print *, ble(i,j), blt(z'ff',z'fa')
end
gives an ICE
f951: internal compiler error: in compare_bitwise, at fortran/simplify.c:1516
which is
gcc_assert (i->ts.type == BT_INTEGER);
gcc_assert (j->ts.type == BT_INTEGER);
(3) Compiling (variant of pr54072)
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
INTEGER, PARAMETER :: GLbitfield=C_INT
INTEGER(GLbitfield), PARAMETER :: GL_CURRENT_BIT = INT(z'00000001') ! 0x00000001
INTEGER(GLbitfield), PARAMETER :: GL_CLIENT_ALL_ATTRIB_BITS = &
transfer(z'ffffffff',GL_CURRENT_BIT) ! 0xffffffff
print *, GLbitfield, GL_CURRENT_BIT, GL_CLIENT_ALL_ATTRIB_BITS
END
gives an ICE
f951: internal compiler error: Invalid expression in gfc_element_size.
(4) Compiling
print *, INT(z'ffffffff',4)
end
gives
print *, INT(z'ffffffff',4)
1
Error: Arithmetic overflow converting INTEGER(-1) to INTEGER(4) at (1). This check can be disabled with the option '-fno-range-check’
Should not it be -1?
(5) Compiling
print *, real(z'ffffffff',4)
end
gives
print *, real(z'ffffffff',4)
1
Error: Arithmetic NaN converting REAL(4) to REAL(4) at (1). This check can be disabled with the option '-fno-range-check’
Why not a warning?
(6) Compiling
print *, storage_size(z'FFFFFFFF')
end
gives an ICE
f951: internal compiler error: Invalid expression in gfc_element_size.
The code is probably invalid, but I don’t know how to parse
> The processor shall allow the position of the leftmost nonzero bit to be at least z - 1,
> where z is the maximum value that could result from invoking the intrinsic function
> STORAGE_SIZE (13.8.175) with an argument that is a real or integer scalar of any kind
> supported by the processor.
Without the patch it returns 128 at run time.
Dominique
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2017-10-09 18:19 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-10-06 20:34 [PATCH] Fortran -- Handle BOZ in accordance with F2008/2015 Steve Kargl
2017-10-07 4:30 ` Jerry DeLisle
2017-10-07 4:51 ` Steve Kargl
2017-10-07 10:37 Dominique d'Humières
2017-10-07 15:48 ` Steve Kargl
2017-10-09 16:48 ` Dominique d'Humières
2017-10-09 18:19 ` Steve Kargl
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).