[gcc r13-1165] Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986]

[gcc r13-1165] Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986]

[Harald Anlauf]

https://gcc.gnu.org/g:856a9b8fc2b457963898c539f0db92a1baa0bf27

commit r13-1165-g856a9b8fc2b457963898c539f0db92a1baa0bf27
Author: Harald Anlauf <anlauf@gmx.de>
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