[PATCH] Fortran: fix corner case of IBITS intrinsic [PR108937]

[Harald Anlauf <anlauf@gmx.de>]

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

Dear all,

as found by the reporter, the result of the intrinsic IBITS
differed from other compilers (e.g. Intel, NAG) for the corner
case that the LEN argument was equal to BIT_SIZE(I), which is
explicitly allowed by the standard.

We actually had an inconsistency for this case between
code generated by the frontend and compile-time simplified
expressions.

The reporter noticed that this is related to a restriction in
gcc that requires that shift widths shall be smaller than the
bit sizes, and we already special case this for ISHFT.
It makes sense to use the same special casing for IBITS.

Attached patch fixes this and regtests on x86_64-pc-linux-gnu.

OK for mainline?

This issue has been there for ages.  Shall this be backported
or left in release branches as is?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr108937.diff --]
[-- Type: text/x-patch, Size: 3252 bytes --]

From 6844c5ecb271e091a8c913903a79eac932cf5f76 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 27 Feb 2023 21:37:11 +0100
Subject: [PATCH] Fortran: fix corner case of IBITS intrinsic [PR108937]

gcc/fortran/ChangeLog:

	PR fortran/108937
	* trans-intrinsic.cc (gfc_conv_intrinsic_ibits): Handle corner case
	LEN argument of IBITS equal to BITSIZE(I).

gcc/testsuite/ChangeLog:

	PR fortran/108937
	* gfortran.dg/ibits_2.f90: New test.
---
 gcc/fortran/trans-intrinsic.cc        | 10 +++++++++
 gcc/testsuite/gfortran.dg/ibits_2.f90 | 32 +++++++++++++++++++++++++++
 2 files changed, 42 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/ibits_2.f90

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 21eeb12ca89..3cce9c0166e 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -6638,6 +6638,7 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
   tree type;
   tree tmp;
   tree mask;
+  tree num_bits, cond;

   gfc_conv_intrinsic_function_args (se, expr, args, 3);
   type = TREE_TYPE (args[0]);
@@ -6678,8 +6679,17 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
 			       "in intrinsic IBITS", tmp1, tmp2, nbits);
     }

+  /* The Fortran standard allows (shift width) LEN <= BIT_SIZE(I), whereas
+     gcc requires a shift width < BIT_SIZE(I), so we have to catch this
+     special case.  See also gfc_conv_intrinsic_ishft ().  */
+  num_bits = build_int_cst (TREE_TYPE (args[2]), TYPE_PRECISION (type));
+
   mask = build_int_cst (type, -1);
   mask = fold_build2_loc (input_location, LSHIFT_EXPR, type, mask, args[2]);
+  cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, args[2],
+			  num_bits);
+  mask = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			  build_int_cst (type, 0), mask);
   mask = fold_build1_loc (input_location, BIT_NOT_EXPR, type, mask);

   tmp = fold_build2_loc (input_location, RSHIFT_EXPR, type, args[0], args[1]);
diff --git a/gcc/testsuite/gfortran.dg/ibits_2.f90 b/gcc/testsuite/gfortran.dg/ibits_2.f90
new file mode 100644
index 00000000000..2af5542d764
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ibits_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bits" }
+! PR fortran/108937 - Intrinsic IBITS(I,POS,LEN) fails when LEN equals
+!                     to BIT_SIZE(I)
+! Contributed by saitofuyuki@jamstec.go.jp
+
+program test_bits
+  implicit none
+  integer, parameter :: KT = kind (1)
+  integer, parameter :: lbits = bit_size (0_KT)
+  integer(kind=KT) :: x, y0, y1
+  integer(kind=KT) :: p, l
+
+  x = -1
+  p = 0
+  do l = 0, lbits
+     y0 = ibits  (x, p, l)
+     y1 = ibits_1(x, p, l)
+     if (y0 /= y1) then
+        print *, l, y0, y1
+        stop 1+l
+     end if
+  end do
+contains
+  elemental integer(kind=KT) function ibits_1(I, POS, LEN) result(n)
+    !! IBITS(I, POS, LEN) = (I >> POS) & ~((~0) << LEN)
+    implicit none
+    integer(kind=KT),intent(in) :: I
+    integer,         intent(in) :: POS, LEN
+    n = IAND (ISHFT(I, - POS), NOT(ISHFT(-1_KT, LEN)))
+  end function ibits_1
+end program test_bits
--
2.35.3