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;
}
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;
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;
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;
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;
}
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;
}
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,
}
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);
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);
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);