[PATCH] Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 280 bytes --]

Dear all,

we need to check the POS (and LEN) arguments of bit intrinsics
when simplifying, e.g. when used in array constructors.
Otherwise we ICE.  Found by Gerhard.

The fix is straightforward, see attached.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fortran-check-POS-and-LEN-arguments-simplifying-bit-.patch --]
[-- Type: text/x-patch, Size: 3456 bytes --]

From 32c95012378ada5ce555a819dbc640e1dd2b88d5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 15 Jun 2022 22:20:09 +0200
Subject: [PATCH] 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.
---
 gcc/fortran/simplify.cc                    | 12 ++++++++++++
 gcc/testsuite/gfortran.dg/check_bits_3.f90 | 16 ++++++++++++++++
 2 files changed, 28 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/check_bits_3.f90

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
--
2.35.3