mvbits_9.f90: New test.
2010-06-09 Steven G. Kargl <kargl@gcc.gnu.org> * testsuite/gfortran.dg/mvbits_9.f90: New test. * testsuite/gfortran.dg/ibset_1.f90: Ditto. * testsuite/gfortran.dg/ibits_1.f90: Ditto. * testsuite/gfortran.dg/btest_1.f90: Ditto. * testsuite/gfortran.dg/ibclr_1.f90: Ditto. 2010-06-09 Steven G. Kargl <kargl@gcc.gnu.org> * fortran/intrinsic.c (add_functions): Change gfc_check_btest, gfc_check_ibclr, and gfc_check_ibset to gfc_check_bitfcn. * fortran/intrinsic.h: Remove prototypes for gfc_check_btest, gfc_check_ibclr, and gfc_check_ibset. Add prototype for gfc_check_bitfcn. * fortran/check.c (nonnegative_check, less_than_bitsize1, less_than_bitsize2): New functions. (gfc_check_btest): Renamed to gfc_check_bitfcn. Use nonnegative_check and less_than_bitsize1. (gfc_check_ibclr, gfc_check_ibset): Removed. (gfc_check_ibits,gfc_check_mvbits): Use nonnegative_check and less_than_bitsize1. From-SVN: r160495
This commit is contained in:
Steven G. Kargl
parent
19acf488f3
commit
3f50f5d5a2
|
|
@ -1,3 +1,18 @@
|
|||
2010-06-09 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
* fortran/intrinsic.c (add_functions): Change gfc_check_btest,
|
||||
gfc_check_ibclr, and gfc_check_ibset to gfc_check_bitfcn.
|
||||
* fortran/intrinsic.h: Remove prototypes for gfc_check_btest,
|
||||
gfc_check_ibclr, and gfc_check_ibset. Add prototype for
|
||||
gfc_check_bitfcn.
|
||||
* fortran/check.c (nonnegative_check, less_than_bitsize1,
|
||||
less_than_bitsize2): New functions.
|
||||
(gfc_check_btest): Renamed to gfc_check_bitfcn. Use
|
||||
nonnegative_check and less_than_bitsize1.
|
||||
(gfc_check_ibclr, gfc_check_ibset): Removed.
|
||||
(gfc_check_ibits,gfc_check_mvbits): Use nonnegative_check and
|
||||
less_than_bitsize1.
|
||||
|
||||
2010-06-02 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/44360
|
||||
|
|
|
|||
|
|
@ -214,6 +214,80 @@ array_check (gfc_expr *e, int n)
|
|||
}
|
||||
|
||||
|
||||
/* If expr is a constant, then check to ensure that it is greater than
|
||||
of equal to zero. */
|
||||
|
||||
static gfc_try
|
||||
nonnegative_check (const char *arg, gfc_expr *expr)
|
||||
{
|
||||
int i;
|
||||
|
||||
if (expr->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
gfc_extract_int (expr, &i);
|
||||
if (i < 0)
|
||||
{
|
||||
gfc_error ("'%s' at %L must be nonnegative", arg, &expr->where);
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/* If expr2 is constant, then check that the value is less than
|
||||
bit_size(expr1). */
|
||||
|
||||
static gfc_try
|
||||
less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
|
||||
gfc_expr *expr2)
|
||||
{
|
||||
int i2, i3;
|
||||
|
||||
if (expr2->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
gfc_extract_int (expr2, &i2);
|
||||
i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
|
||||
if (i2 >= gfc_integer_kinds[i3].bit_size)
|
||||
{
|
||||
gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
|
||||
arg2, &expr2->where, arg1);
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/* If expr2 and expr3 are constants, then check that the value is less than
|
||||
or equal to bit_size(expr1). */
|
||||
|
||||
static gfc_try
|
||||
less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
|
||||
gfc_expr *expr2, const char *arg3, gfc_expr *expr3)
|
||||
{
|
||||
int i2, i3;
|
||||
|
||||
if (expr2->expr_type == EXPR_CONSTANT && expr3->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
gfc_extract_int (expr2, &i2);
|
||||
gfc_extract_int (expr3, &i3);
|
||||
i2 += i3;
|
||||
i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
|
||||
if (i2 > gfc_integer_kinds[i3].bit_size)
|
||||
{
|
||||
gfc_error ("'%s + %s' at %L must be less than or equal "
|
||||
"to BIT_SIZE('%s')",
|
||||
arg2, arg3, &expr2->where, arg1);
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
/* Make sure two expressions have the same type. */
|
||||
|
||||
static gfc_try
|
||||
|
|
@ -693,13 +767,20 @@ gfc_check_besn (gfc_expr *n, gfc_expr *x)
|
|||
|
||||
|
||||
gfc_try
|
||||
gfc_check_btest (gfc_expr *i, gfc_expr *pos)
|
||||
gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
|
||||
{
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (nonnegative_check ("pos", pos) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (less_than_bitsize1 ("i", i, "pos", pos) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
|
@ -1221,19 +1302,6 @@ gfc_check_iand (gfc_expr *i, gfc_expr *j)
|
|||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
gfc_check_ibclr (gfc_expr *i, gfc_expr *pos)
|
||||
{
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len)
|
||||
{
|
||||
|
|
@ -1246,17 +1314,13 @@ gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len)
|
|||
if (type_check (len, 2, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
gfc_try
|
||||
gfc_check_ibset (gfc_expr *i, gfc_expr *pos)
|
||||
{
|
||||
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
||||
if (nonnegative_check ("pos", pos) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
||||
if (nonnegative_check ("len", len) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (less_than_bitsize2 ("i", i, "pos", pos, "len", len) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
|
|
@ -3127,6 +3191,22 @@ gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
|
|||
if (type_check (topos, 4, BT_INTEGER) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (nonnegative_check ("frompos", frompos) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (nonnegative_check ("topos", topos) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (nonnegative_check ("len", len) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (less_than_bitsize2 ("from", from, "frompos", frompos, "len", len)
|
||||
== FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (less_than_bitsize2 ("to", to, "topos", topos, "len", len) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1232,7 +1232,7 @@ add_functions (void)
|
|||
make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
|
||||
|
||||
add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
|
||||
gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
|
||||
gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
|
||||
i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
|
||||
|
|
@ -1611,7 +1611,7 @@ add_functions (void)
|
|||
make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
|
||||
|
||||
add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
|
||||
gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
|
||||
gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
|
||||
i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
|
||||
|
|
@ -1624,7 +1624,7 @@ add_functions (void)
|
|||
make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
|
||||
|
||||
add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
|
||||
gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
|
||||
gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
|
||||
i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
|
||||
|
||||
make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ gfc_try gfc_check_allocated (gfc_expr *);
|
|||
gfc_try gfc_check_associated (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_btest (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_bitfcn (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_char (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_chdir (gfc_expr *);
|
||||
gfc_try gfc_check_chmod (gfc_expr *, gfc_expr *);
|
||||
|
|
@ -71,9 +71,7 @@ gfc_try gfc_check_hypot (gfc_expr *, gfc_expr *);
|
|||
gfc_try gfc_check_i (gfc_expr *);
|
||||
gfc_try gfc_check_iand (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_and (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ibclr (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ibset (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
|
||||
gfc_try gfc_check_idnint (gfc_expr *);
|
||||
gfc_try gfc_check_ieor (gfc_expr *, gfc_expr *);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2010-06-09 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
* testsuite/gfortran.dg/mvbits_9.f90: New test.
|
||||
* testsuite/gfortran.dg/ibset_1.f90: Ditto.
|
||||
* testsuite/gfortran.dg/ibits_1.f90: Ditto.
|
||||
* testsuite/gfortran.dg/btest_1.f90: Ditto.
|
||||
* testsuite/gfortran.dg/ibclr_1.f90: Ditto.
|
||||
|
||||
2010-06-07 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
* gcc.dg/torture/fp-int-convert-float128-timode.c: Skip on
|
||||
|
|
|
|||
|
|
@ -0,0 +1,7 @@
|
|||
! { dg-do compile }
|
||||
program a
|
||||
integer :: i = 42
|
||||
logical l
|
||||
l = btest(i, -1) ! { dg-error "must be nonnegative" }
|
||||
l = btest(i, 65) ! { dg-error "must be less than" }
|
||||
end program a
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
! { dg-do compile }
|
||||
program a
|
||||
integer :: i = 42
|
||||
integer l
|
||||
l = ibclr(i, -1) ! { dg-error "must be nonnegative" }
|
||||
l = ibclr(i, 65) ! { dg-error "must be less than" }
|
||||
end program a
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! PR fortran/44346
|
||||
! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
|
||||
! Modified by Steven G. Kargl for dejagnu testsuite.
|
||||
!
|
||||
program a
|
||||
integer :: j, i = 42
|
||||
j = ibits(i, -1, 1) ! { dg-error "must be nonnegative" }
|
||||
j = ibits(i, 1, -1) ! { dg-error "must be nonnegative" }
|
||||
j = ibits(i, 100, 100) ! { dg-error "must be less than" }
|
||||
end program a
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
! { dg-do compile }
|
||||
program a
|
||||
integer :: i = 42
|
||||
integer l
|
||||
l = ibset(i, -1) ! { dg-error "must be nonnegative" }
|
||||
l = ibset(i, 65) ! { dg-error "must be less than" }
|
||||
end program a
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! PR fortran/44346
|
||||
! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
|
||||
! Modified by Steven G. Kargl for dejagnu testsuite.
|
||||
!
|
||||
program a
|
||||
integer :: n = 42
|
||||
! 64 + 3 > bitsize(n)
|
||||
call mvbits(n, 64, 3, n, 1) ! { dg-error "must be less than" }
|
||||
! 64 + 2 > bitsize(n)
|
||||
call mvbits(n, 30, 2, n, 64) ! { dg-error "must be less than" }
|
||||
! LEN negative
|
||||
call mvbits(n, 30, -2, n, 30) ! { dg-error "must be nonnegative" }
|
||||
! TOPOS negative
|
||||
call mvbits(n, 30, 2, n, -3) ! { dg-error "must be nonnegative" }
|
||||
! FROMPOS negative
|
||||
call mvbits(n, -1, 2, n, 3) ! { dg-error "must be nonnegative" }
|
||||
end program a
|
||||
Loading…
Reference in New Issue