re PR fortran/16581 (gfortran F90 bit intrinsics don't work with integer*{1,2,8})
2004-12-12 Steven G. Kargl <kargls@comcast.net> PR fortran/16581 * check.c (gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset, gfc_check_ieor, gfc_check_ior): Remove default integer kind check; Issue error for -std=f95 when needed. * intrinsic.c (add_functions): Change ieor from GFC_STD_GNU to GFC_STD_F95. * iresolve.c (gfc_resolve_iand, gfc_resolve_ieor, gfc_resolve_ior): Promote arguments to same kind. From-SVN: r92063
This commit is contained in:
parent
0736fd563f
commit
c3d003d207
|
@ -1,3 +1,14 @@
|
|||
2004-12-12 Steven G. Kargl <kargls@comcast.net>
|
||||
|
||||
PR fortran/16581
|
||||
* check.c (gfc_check_iand, gfc_check_ibclr, gfc_check_ibits,
|
||||
gfc_check_ibset, gfc_check_ieor, gfc_check_ior): Remove default
|
||||
integer kind check; Issue error for -std=f95 when needed.
|
||||
* intrinsic.c (add_functions): Change ieor from GFC_STD_GNU to
|
||||
GFC_STD_F95.
|
||||
* iresolve.c (gfc_resolve_iand, gfc_resolve_ieor, gfc_resolve_ior):
|
||||
Promote arguments to same kind.
|
||||
|
||||
2004-12-12 Steven G. Kargl <kargls@comcast.net>
|
||||
Paul Brook <paul@codesourcery.com>
|
||||
|
||||
|
|
|
@ -809,13 +809,19 @@ try
|
|||
gfc_check_iand (gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (same_type_check (i, 0, j, 1) == FAILURE)
|
||||
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (i->ts.kind != j->ts.kind)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
||||
&i->where) == FAILURE)
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
@ -824,9 +830,10 @@ try
|
|||
gfc_check_ibclr (gfc_expr * i, gfc_expr * pos)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (pos, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
|
@ -837,10 +844,13 @@ try
|
|||
gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (pos, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE
|
||||
|| type_check (len, 2, BT_INTEGER) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (len, 2, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
|
@ -851,9 +861,10 @@ try
|
|||
gfc_check_ibset (gfc_expr * i, gfc_expr * pos)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (pos, 1, BT_INTEGER) == FAILURE
|
||||
|| kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
|
@ -875,13 +886,19 @@ try
|
|||
gfc_check_ieor (gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (same_type_check (i, 0, j, 1) == FAILURE)
|
||||
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (i->ts.kind != j->ts.kind)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
||||
&i->where) == FAILURE)
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
@ -924,13 +941,19 @@ try
|
|||
gfc_check_ior (gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
||||
|| type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (same_type_check (i, 0, j, 1) == FAILURE)
|
||||
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (i->ts.kind != j->ts.kind)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
||||
&i->where) == FAILURE)
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
|
|
@ -1375,11 +1375,11 @@ add_functions (void)
|
|||
|
||||
make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
|
||||
|
||||
add_sym_2 ("ieor", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
|
||||
add_sym_2 ("ieor", 1, 1, BT_INTEGER, di, GFC_STD_F95,
|
||||
gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
|
||||
i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_GNU);
|
||||
make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
|
||||
|
||||
add_sym_3 ("index", 1, 1, BT_INTEGER, di, GFC_STD_F77,
|
||||
gfc_check_index, gfc_simplify_index, NULL,
|
||||
|
|
|
@ -619,8 +619,18 @@ gfc_resolve_getuid (gfc_expr * f)
|
|||
}
|
||||
|
||||
void
|
||||
gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j ATTRIBUTE_UNUSED)
|
||||
gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
/* 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);
|
||||
|
@ -676,9 +686,18 @@ gfc_resolve_idnint (gfc_expr * f, gfc_expr * a)
|
|||
|
||||
|
||||
void
|
||||
gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
|
||||
gfc_expr * j ATTRIBUTE_UNUSED)
|
||||
gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
/* 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);
|
||||
|
@ -686,9 +705,18 @@ gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
|
|||
|
||||
|
||||
void
|
||||
gfc_resolve_ior (gfc_expr * f, gfc_expr * i,
|
||||
gfc_expr * j ATTRIBUTE_UNUSED)
|
||||
gfc_resolve_ior (gfc_expr * f, gfc_expr * i, gfc_expr * j)
|
||||
{
|
||||
/* 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);
|
||||
|
|
Loading…
Reference in New Issue