From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id AFE45385828A; Sat, 18 Jun 2022 16:57:39 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AFE45385828A MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1165] Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/master X-Git-Oldrev: 2c7cfc7b418564a2f1f0e7a5b38dec7013ba5e18 X-Git-Newrev: 856a9b8fc2b457963898c539f0db92a1baa0bf27 Message-Id: <20220618165739.AFE45385828A@sourceware.org> Date: Sat, 18 Jun 2022 16:57:39 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sat, 18 Jun 2022 16:57:39 -0000 https://gcc.gnu.org/g:856a9b8fc2b457963898c539f0db92a1baa0bf27 commit r13-1165-g856a9b8fc2b457963898c539f0db92a1baa0bf27 Author: Harald Anlauf Date: Wed Jun 15 22:20:09 2022 +0200 Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986] gcc/fortran/ChangeLog: PR fortran/105986 * simplify.cc (gfc_simplify_btest): Add check for POS argument. (gfc_simplify_ibclr): Add check for POS argument. (gfc_simplify_ibits): Add check for POS and LEN arguments. (gfc_simplify_ibset): Add check for POS argument. gcc/testsuite/ChangeLog: PR fortran/105986 * gfortran.dg/check_bits_3.f90: New test. Diff: --- gcc/fortran/simplify.cc | 12 ++++++++++++ gcc/testsuite/gfortran.dg/check_bits_3.f90 | 16 ++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 233cc42137f..c8f2ef9fbf4 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -1644,6 +1644,9 @@ gfc_simplify_btest (gfc_expr *e, gfc_expr *bit) if (e->expr_type != EXPR_CONSTANT || bit->expr_type != EXPR_CONSTANT) return NULL; + if (!gfc_check_bitfcn (e, bit)) + return &gfc_bad_expr; + if (gfc_extract_int (bit, &b) || b < 0) return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, false); @@ -3353,6 +3356,9 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y) if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; + if (!gfc_check_bitfcn (x, y)) + return &gfc_bad_expr; + gfc_extract_int (y, &pos); k = gfc_validate_kind (x->ts.type, x->ts.kind, false); @@ -3384,6 +3390,9 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z) || z->expr_type != EXPR_CONSTANT) return NULL; + if (!gfc_check_ibits (x, y, z)) + return &gfc_bad_expr; + gfc_extract_int (y, &pos); gfc_extract_int (z, &len); @@ -3438,6 +3447,9 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y) if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; + if (!gfc_check_bitfcn (x, y)) + return &gfc_bad_expr; + gfc_extract_int (y, &pos); k = gfc_validate_kind (x->ts.type, x->ts.kind, false); diff --git a/gcc/testsuite/gfortran.dg/check_bits_3.f90 b/gcc/testsuite/gfortran.dg/check_bits_3.f90 new file mode 100644 index 00000000000..3018e6977ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/check_bits_3.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! PR fortran/105986 +! Contributed by G.Steinmetz + +program p + integer :: i + logical, parameter :: a(*) = [(btest(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" } + integer, parameter :: b(*) = [(ibclr(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" } + integer, parameter :: c(*) = [(ibset(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" } + logical, parameter :: d(*) = [(btest(8_1,i), i= 8, 8)] ! { dg-error "must be less" } + integer, parameter :: e(*) = [(ibclr(8_2,i), i=16,16)] ! { dg-error "must be less" } + integer, parameter :: f(*) = [(ibset(8_4,i), i=32,32)] ! { dg-error "must be less" } + integer, parameter :: g(*) = [(ibits(8_4,i,1),i=-1,-1)] ! { dg-error "nonnegative" } + integer, parameter :: h(*) = [(ibits(8_4,1,i),i=-1,-1)] ! { dg-error "nonnegative" } + integer, parameter :: j(*) = [(ibits(8_4,i,i),i=32,32)] ! { dg-error "must be less" } +end