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
@@ -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
new file mode 100644
@@ -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
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.