Skip to content

R
riscv-gcc-1
Commit c3d003d2 by Steven G. Kargl Committed by Paul Brook
Options

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
parent 0736fd56
Showing with 88 additions and 26 deletions
gcc/fortran/ChangeLog
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>
PR fortran/16222
......
gcc/fortran/check.c
......@@ -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;
}
......
gcc/fortran/intrinsic.c
......@@ -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,
......
gcc/fortran/iresolve.c
......@@ -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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment