diff mbox series

Fortran: intrinsic ISHFTC and missing optional argument SIZE [PR67277]

Message ID trinity-a5fb737b-a44a-44b3-a0a0-599d2c1f89bf-1705180362791@3c-app-gmx-bs12
State Accepted
Headers
Series Fortran: intrinsic ISHFTC and missing optional argument SIZE [PR67277] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Harald Anlauf Jan. 13, 2024, 9:12 p.m. UTC 
  Dear all,

the testcase given in PR67277 actually consists of two separate issues:

(1) passing an optional dummy argument to an elemental (intrinsic) procedure

(2) a missing optional argument for SIZE to the ISHFTC intrinsic
    shall be equivalent to using BIT_SIZE(I).

I've created a separate PR113377 for (1), as this looks like a more
general issue with the scalarizer.

The attached, rather simple and obvious patch thus fixes (2).
Besides testing that the patch works as advertised, the testcase
also contains variations that need fixing of PR113377 before they
can be uncommented.

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

As I consider the patch safe, I'd like to backport to 13-branch later.

Thanks,
Harald

P.S.: if someone out there feels familiar with the scalarizer,
a look at PR113377 is appreciated.

Comments

Steve Kargl Jan. 13, 2024, 9:57 p.m. UTC | #1 
On Sat, Jan 13, 2024 at 10:12:42PM +0100, Harald Anlauf wrote:
> 
> (2) a missing optional argument for SIZE to the ISHFTC intrinsic
>     shall be equivalent to using BIT_SIZE(I).
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
> As I consider the patch safe, I'd like to backport to 13-branch later.
> 

OK for both trunk and a backport as time permits.
diff mbox series

Patch

From 20da56165273c8814b3c53e6d71549ba6a37e0cd Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 13 Jan 2024 22:00:21 +0100
Subject: [PATCH] Fortran: intrinsic ISHFTC and missing optional argument SIZE
 [PR67277]

gcc/fortran/ChangeLog:

	PR fortran/67277
	* trans-intrinsic.cc (gfc_conv_intrinsic_ishftc): Handle optional
	dummy argument for SIZE passed to ISHFTC.  Set default value to
	BIT_SIZE(I) when missing.

gcc/testsuite/ChangeLog:

	PR fortran/67277
	* gfortran.dg/ishftc_optional_size_1.f90: New test.
---
 gcc/fortran/trans-intrinsic.cc                | 14 +++
 .../gfortran.dg/ishftc_optional_size_1.f90    | 97 +++++++++++++++++++
 2 files changed, 111 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 74139262657..0468dfae2b1 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -6863,9 +6863,23 @@  gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)

   if (num_args == 3)
     {
+      gfc_expr *size = expr->value.function.actual->next->next->expr;
+
       /* Use a library function for the 3 parameter version.  */
       tree int4type = gfc_get_int_type (4);

+      /* Treat optional SIZE argument when it is passed as an optional
+	 dummy.  If SIZE is absent, the default value is BIT_SIZE(I).  */
+      if (size->expr_type == EXPR_VARIABLE
+	  && size->symtree->n.sym->attr.dummy
+	  && size->symtree->n.sym->attr.optional)
+	{
+	  tree type_of_size = TREE_TYPE (args[2]);
+	  args[2] = build3_loc (input_location, COND_EXPR, type_of_size,
+				gfc_conv_expr_present (size->symtree->n.sym),
+				args[2], fold_convert (type_of_size, nbits));
+	}
+
       /* We convert the first argument to at least 4 bytes, and
 	 convert back afterwards.  This removes the need for library
 	 functions for all argument sizes, and function will be
diff --git a/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90 b/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90
new file mode 100644
index 00000000000..1ccf4b38caa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90
@@ -0,0 +1,97 @@ 
+! { dg-do run }
+!
+! PR fortran/67277 - ISHFTC and missing optional argument SIZE
+
+module m
+  implicit none
+contains
+  ! Optional argument passed by reference
+  elemental function ishftc4_ref (i, shift, size_) result(r)
+    integer(4), intent(in)           :: i
+    integer,    intent(in)           :: shift
+    integer,    intent(in), optional :: size_
+    integer                          :: r
+    r = ishftc (i, shift=shift, size=size_)
+  end
+
+  elemental function ishftc1_ref (i, shift, size_) result(r)
+    integer(1), intent(in)           :: i
+    integer,    intent(in)           :: shift
+    integer(1), intent(in), optional :: size_
+    integer(1)                       :: r
+    r = ishftc (i, shift=shift, size=size_)
+  end
+
+  ! Array valued argument i
+  function ishftc4_ref_4 (i, shift, size_) result(r)
+    integer(4), intent(in)           :: i(4)
+    integer,    intent(in)           :: shift
+    integer,    intent(in), optional :: size_
+    integer                          :: r(size(i))
+    r = ishftc (i, shift=shift, size=size_)
+  end
+
+  ! Optional argument passed by value
+  elemental function ishftc4_val (i, shift, size_) result(r)
+    integer(4), intent(in)           :: i
+    integer,    intent(in)           :: shift
+    integer,    value,      optional :: size_
+    integer                          :: r
+    r = ishftc (i, shift=shift, size=size_)
+  end
+
+  elemental function ishftc1_val (i, shift, size_) result(r)
+    integer(1), intent(in)           :: i
+    integer,    intent(in)           :: shift
+    integer(1), value,      optional :: size_
+    integer(1)                       :: r
+    r = ishftc (i, shift=shift, size=size_)
+  end
+
+  ! Array valued argument i
+  function ishftc4_val_4 (i, shift, size_) result(r)
+    integer(4), intent(in)           :: i(4)
+    integer,    intent(in)           :: shift
+    integer,    value,      optional :: size_
+    integer                          :: r(size(i))
+    r = ishftc (i, shift=shift, size=size_)
+  end
+end module m
+
+program p
+  use m
+  implicit none
+  integer    :: shift = 1
+  integer(4) :: i4 = 127, j4(4), k4(4)
+  integer(1) :: i1 = 127
+  integer(4) :: expect4
+  integer(1) :: expect1
+
+  ! Scalar variants
+  expect4 = 2*i4
+  if (ishftc      (i4, shift) /= expect4) stop 1
+  if (ishftc4_ref (i4, shift) /= expect4) stop 2
+  if (ishftc4_val (i4, shift) /= expect4) stop 3
+
+  expect1 = -2_1
+  if (ishftc      (i1, shift) /= expect1) stop 4
+  if (ishftc1_ref (i1, shift) /= expect1) stop 5
+  if (ishftc1_val (i1, shift) /= expect1) stop 6
+
+  ! Array arguments
+  expect4 = 2*i4
+  j4 = i4
+  k4 = ishftc        (j4, shift)
+  if (any (k4 /= expect4)) stop 7
+
+  ! The following works on x86_64 but might currently fail on other systems:
+  ! (see PR113377)
+! k4 = ishftc4_val_4 (j4, shift)
+! if (any (k4 /= expect4)) stop 8
+
+  ! The following currently segfaults (might be a scalarizer issue):
+  ! (see PR113377)
+! k4 = ishftc4_ref_4 (j4, shift)
+! print *, k4
+! if (any (k4 /= expect4)) stop 9
+end program p
--
2.35.3