diff mbox series

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

Message ID trinity-fe057ccc-fa64-44dd-b508-ec0ab33ea8e4-1655324780076@3c-app-gmx-bap59
State New
Headers
Series Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986] |

Commit Message

Harald Anlauf June 15, 2022, 8:26 p.m. UTC 
  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

Comments

Thomas Koenig June 18, 2022, 4:19 p.m. UTC | #1 
Hi Harald,

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

OK.

Thanks for the patch!

Regards

	Thomas
diff mbox series

Patch

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