[PATCH, part3, committed] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]

[PATCH, part3, committed] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]

[Harald Anlauf]

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

Dear all,

the previous patches to this PR unfortunately caused a regression,
seen on Power big-endian systems/-m32 (pr110419), and while trying
to investigate on x86 also showed a regression (ICE) on cases that
were not covered in the testsuite before.

The original fix did not properly handle the dereferencing of
string arguments that were not constant, and it was lacking the
truncation of strings to length one that is needed when passing
a character on the stack.

This patch has been regtested on x86_64-pc-linux-gnu,
and the extended testcase was scrutinized with -m64 and -m32.

Pushed after discussion in the PR with Mikael as
commit r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa

https://gcc.gnu.org/g:8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa

Will keep the PR open as long as the issues on Power big-endian
are not confirmed resolved.

Thanks,
Harald


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

From 8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 28 Jun 2023 22:16:18 +0200
Subject: [PATCH] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument
 [PR110360]

gcc/fortran/ChangeLog:

	PR fortran/110360
	* trans-expr.cc (gfc_conv_procedure_call): For non-constant string
	argument passed to CHARACTER(LEN=1),VALUE dummy, ensure proper
	dereferencing and truncation of string to length 1.

gcc/testsuite/ChangeLog:

	PR fortran/110360
	* gfortran.dg/value_9.f90: Add tests for intermediate regression.
---
 gcc/fortran/trans-expr.cc             | 15 ++++++++++-----
 gcc/testsuite/gfortran.dg/value_9.f90 | 23 +++++++++++++++++++++++
 2 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ad0cdf902ba..30946ba3f63 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6395,7 +6395,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,

 		    /* ABI: actual arguments to CHARACTER(len=1),VALUE
 		       dummy arguments are actually passed by value.
-		       Constant strings are truncated to length 1.
+		       Strings are truncated to length 1.
 		       The BIND(C) case is handled elsewhere.  */
 		    if (fsym->ts.type == BT_CHARACTER
 			&& !fsym->ts.is_c_interop
@@ -6405,10 +6405,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			    (fsym->ts.u.cl->length->value.integer, 1) == 0))
 		      {
 			if (e->expr_type != EXPR_CONSTANT)
-			  parmse.expr = gfc_string_to_single_character
-			    (build_int_cst (gfc_charlen_type_node, 1),
-			     parmse.expr,
-			     e->ts.kind);
+			  {
+			    tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
+			    gfc_conv_string_parameter (&parmse);
+			    parmse.expr = gfc_string_to_single_character (slen1,
+									  parmse.expr,
+									  e->ts.kind);
+			    /* Truncate resulting string to length 1.  */
+			    parmse.string_length = slen1;
+			  }
 			else if (e->value.character.length > 1)
 			  {
 			    e->value.character.length = 1;
diff --git a/gcc/testsuite/gfortran.dg/value_9.f90 b/gcc/testsuite/gfortran.dg/value_9.f90
index f6490645e27..1a2fa80ed0d 100644
--- a/gcc/testsuite/gfortran.dg/value_9.f90
+++ b/gcc/testsuite/gfortran.dg/value_9.f90
@@ -9,7 +9,12 @@ program p
   character      (kind=4), allocatable :: ca4
   character      (kind=4), pointer     :: cp4
   character(len=:,kind=4), allocatable :: cd4
+  character                            :: c  =   "1"
+  character      (kind=4)              :: c4 = 4_"4"
+  character(len=3)                     :: d  =   "210"
+  character(len=3,kind=4)              :: d4 = 4_"321"
   integer :: a = 65
+  integer :: l = 2
   allocate (ca, cp, ca4, cp4)

   ! Check len=1 actual argument cases first
@@ -20,15 +25,21 @@ program p
   call val  ("A",char(a))
   call val  ("A",mychar(65))
   call val  ("A",mychar(a))
+  call val  ("1",c)
+  call val  ("1",(c))
   call val4 (4_"C",4_"C")
   call val4 (4_"A",char(65,kind=4))
   call val4 (4_"A",char(a, kind=4))
+  call val4 (4_"4",c4)
+  call val4 (4_"4",(c4))
   call val  (ca,ca)
   call val  (cp,cp)
   call val  (cd,cd)
+  call val  (ca,(ca))
   call val4 (ca4,ca4)
   call val4 (cp4,cp4)
   call val4 (cd4,cd4)
+  call val4 (cd4,(cd4))
   call sub  ("S")
   call sub4 (4_"T")

@@ -37,6 +48,18 @@ program p
   call val4 (4_"V**",4_"V//")
   call sub  (  "WTY")
   call sub4 (4_"ZXV")
+  call val  (  "234",  d    )
+  call val4 (4_"345",  d4   )
+  call val  (  "234", (d)   )
+  call val4 (4_"345", (d4)  )
+  call val  (  "234",  d (1:2))
+  call val4 (4_"345",  d4(1:2))
+  call val  (  "234",  d (1:l))
+  call val4 (4_"345",  d4(1:l))
+  call val  ("1",c // d)
+  call val  ("1",trim (c // d))
+  call val4 (4_"4",c4 // d4)
+  call val4 (4_"4",trim (c4 // d4))
   cd = "gkl"; cd4 = 4_"hmn"
   call val  (cd,cd)
   call val4 (cd4,cd4)
--
2.35.3