From f1d241cc353f610b130907dbc3a58ab209a326c2 Mon Sep 17 00:00:00 2001 From: kargl Date: Wed, 9 Jun 2010 16:24:59 +0000 Subject: [PATCH] 2010-06-09 Steven G. Kargl * 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160492 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 15 ++++ gcc/fortran/check.c | 124 +++++++++++++++++++++++++++------ gcc/fortran/intrinsic.c | 6 +- gcc/fortran/intrinsic.h | 4 +- gcc/testsuite/ChangeLog | 8 +++ gcc/testsuite/gfortran.dg/btest_1.f90 | 7 ++ gcc/testsuite/gfortran.dg/ibclr_1.f90 | 7 ++ gcc/testsuite/gfortran.dg/ibits_1.f90 | 13 ++++ gcc/testsuite/gfortran.dg/ibset_1.f90 | 7 ++ gcc/testsuite/gfortran.dg/mvbits_9.f90 | 19 +++++ 10 files changed, 182 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/btest_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/ibclr_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/ibits_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/ibset_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/mvbits_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e1faa4d9fdb..0a9361e7f4f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2010-06-09 Steven G. Kargl + + * 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-09 Janus Weil PR fortran/44211 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 3a68c29b543..6a5c263ed50 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -241,6 +241,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 @@ -766,13 +840,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; } @@ -1389,19 +1470,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) { if (type_check (i, 0, BT_INTEGER) == FAILURE) @@ -1413,17 +1481,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; -} - + if (nonnegative_check ("pos", pos) == FAILURE) + return FAILURE; -gfc_try -gfc_check_ibset (gfc_expr *i, gfc_expr *pos) -{ - if (type_check (i, 0, BT_INTEGER) == FAILURE) + if (nonnegative_check ("len", len) == FAILURE) return FAILURE; - if (type_check (pos, 1, BT_INTEGER) == FAILURE) + if (less_than_bitsize2 ("i", i, "pos", pos, "len", len) == FAILURE) return FAILURE; return SUCCESS; @@ -3646,6 +3710,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; } diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index a92b5b54519..2d82f20f957 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1354,7 +1354,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); @@ -1738,7 +1738,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); @@ -1751,7 +1751,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); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 2e1b95eb375..a2cd55a87a9 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -40,7 +40,7 @@ gfc_try gfc_check_associated (gfc_expr *, gfc_expr *); gfc_try gfc_check_atan_2 (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 *); @@ -74,9 +74,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 *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index db037516e29..f98b2be6e98 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2010-06-09 Steven G. Kargl + + * 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 Jason Merrill PR c++/44366 diff --git a/gcc/testsuite/gfortran.dg/btest_1.f90 b/gcc/testsuite/gfortran.dg/btest_1.f90 new file mode 100644 index 00000000000..8a72c314cd5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/btest_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/ibclr_1.f90 b/gcc/testsuite/gfortran.dg/ibclr_1.f90 new file mode 100644 index 00000000000..3932789ec4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ibclr_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/ibits_1.f90 b/gcc/testsuite/gfortran.dg/ibits_1.f90 new file mode 100644 index 00000000000..2bcbe829b86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ibits_1.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/ibset_1.f90 b/gcc/testsuite/gfortran.dg/ibset_1.f90 new file mode 100644 index 00000000000..2ff261dbd2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ibset_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/mvbits_9.f90 b/gcc/testsuite/gfortran.dg/mvbits_9.f90 new file mode 100644 index 00000000000..952286b09a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/mvbits_9.f90 @@ -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 -- 2.11.4.GIT