diff options
| author | Steven G. Kargl <kargls@comcast.net> | 2004-12-12 21:09:09 +0000 |
|---|---|---|
| committer | Paul Brook <pbrook@gcc.gnu.org> | 2004-12-12 21:09:09 +0000 |
| commit | c3d003d207ac27d639e18010dae6b7087ead1beb (patch) | |
| tree | 45e9b6e52d2737fdf74257a64276a9514252ce15 /gcc/fortran/check.c | |
| parent | 0736fd563fa409b16f4cf1c3a7e4c42051f8c6dc (diff) | |
| download | gcc-c3d003d207ac27d639e18010dae6b7087ead1beb.zip gcc-c3d003d207ac27d639e18010dae6b7087ead1beb.tar.gz gcc-c3d003d207ac27d639e18010dae6b7087ead1beb.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 61 |
1 files changed, 42 insertions, 19 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 0b4f92e6..3d67b1c 100644 --- a/gcc/fortran/check.c +++ b/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; } |