diff mbox series

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

Message ID trinity-67cbfb46-d186-40df-86e8-fb36979a34a9-1687465404920@3c-app-gmx-bs06
State New
Headers show
Series Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360] | expand

Commit Message

Harald Anlauf June 22, 2023, 8:23 p.m. UTC 
Dear all,

gfortran's ABI specifies that actual arguments to CHARACTER(LEN=1),VALUE
dummy arguments are passed by value in the scalar case.  That did work
for constant strings being passed, but not in several other cases, where
pointers were passed, resulting in subsequent random junk...

The attached patch fixes this for the case of a non-constant string
argument.

It does not touch the character,value bind(c) case - this is a different
thing and may need separate work, as Mikael pointed out - and there is
a missed optimization for the case of actual constant string arguments
of length larger than 1: it appears that the full string is pushed to
the stack.  I did not address that, as the primary aim here is to get
correctly working code.  (I added a TODO in a comment.)

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

Thanks,
Harald

Comments

Mikael Morin June 23, 2023, 8:04 a.m. UTC | #1 
Le 22/06/2023 à 22:23, Harald Anlauf via Fortran a écrit :
> Dear all,
> 
> gfortran's ABI specifies that actual arguments to CHARACTER(LEN=1),VALUE
> dummy arguments are passed by value in the scalar case.  That did work
> for constant strings being passed, but not in several other cases, where
> pointers were passed, resulting in subsequent random junk...
> 
> The attached patch fixes this for the case of a non-constant string
> argument.
> 
> It does not touch the character,value bind(c) case - this is a different
> thing and may need separate work, as Mikael pointed out - and there is
> a missed optimization for the case of actual constant string arguments
> of length larger than 1: it appears that the full string is pushed to
> the stack.  I did not address that, as the primary aim here is to get
> correctly working code.  (I added a TODO in a comment.)
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
OK, thanks.

> Thanks,
> Harald
>
diff mbox series

Patch

From bea1e14490e4abc4b67bae8fdca5196bb93acd2d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 22 Jun 2023 22:07:41 +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): Pass actual argument
	to scalar CHARACTER(1),VALUE dummy argument by value.

gcc/testsuite/ChangeLog:

	PR fortran/110360
	* gfortran.dg/value_9.f90: New test.
---
 gcc/fortran/trans-expr.cc             | 19 +++++++
 gcc/testsuite/gfortran.dg/value_9.f90 | 78 +++++++++++++++++++++++++++
 2 files changed, 97 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/value_9.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3c209bcde97..c92fccd0be2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6392,6 +6392,25 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  else
 		    {
 		    gfc_conv_expr (&parmse, e);
+
+		    /* ABI: actual arguments to CHARACTER(len=1),VALUE
+		       dummy arguments are actually passed by value.
+		       The BIND(C) case is handled elsewhere.
+		       TODO: truncate constant strings to length 1.  */
+		    if (fsym->ts.type == BT_CHARACTER
+			&& !fsym->ts.is_c_interop
+			&& fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+			&& fsym->ts.u.cl->length->ts.type == BT_INTEGER
+			&& (mpz_cmp_ui
+			    (fsym->ts.u.cl->length->value.integer, 1) == 0)
+			&& 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);
+		      }
+
 		    if (fsym->attr.optional
 			&& fsym->ts.type != BT_CLASS
 			&& fsym->ts.type != BT_DERIVED)
diff --git a/gcc/testsuite/gfortran.dg/value_9.f90 b/gcc/testsuite/gfortran.dg/value_9.f90
new file mode 100644
index 00000000000..f6490645e27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_9.f90
@@ -0,0 +1,78 @@ 
+! { dg-do run }
+! PR fortran/110360 - ABI for scalar character(len=1),value dummy argument
+
+program p
+  implicit none
+  character,               allocatable :: ca
+  character,               pointer     :: cp
+  character(len=:),        allocatable :: cd
+  character      (kind=4), allocatable :: ca4
+  character      (kind=4), pointer     :: cp4
+  character(len=:,kind=4), allocatable :: cd4
+  integer :: a = 65
+  allocate (ca, cp, ca4, cp4)
+
+  ! Check len=1 actual argument cases first
+  ca  =   "a"; cp  =   "b"; cd  =   "c"
+  ca4 = 4_"d"; cp4 = 4_"e"; cd4 = 4_"f"
+  call val  ("B","B")
+  call val  ("A",char(65))
+  call val  ("A",char(a))
+  call val  ("A",mychar(65))
+  call val  ("A",mychar(a))
+  call val4 (4_"C",4_"C")
+  call val4 (4_"A",char(65,kind=4))
+  call val4 (4_"A",char(a, kind=4))
+  call val  (ca,ca)
+  call val  (cp,cp)
+  call val  (cd,cd)
+  call val4 (ca4,ca4)
+  call val4 (cp4,cp4)
+  call val4 (cd4,cd4)
+  call sub  ("S")
+  call sub4 (4_"T")
+
+  ! Check that always the first character of the string is finally used
+  call val  (  "U++",  "U--")
+  call val4 (4_"V**",4_"V//")
+  call sub  (  "WTY")
+  call sub4 (4_"ZXV")
+  cd = "gkl"; cd4 = 4_"hmn"
+  call val  (cd,cd)
+  call val4 (cd4,cd4)
+  call sub  (cd)
+  call sub4 (cd4)
+  deallocate (ca, cp, ca4, cp4, cd, cd4)
+contains
+  subroutine val (x, c)
+    character(kind=1), intent(in) :: x  ! control: pass by reference
+    character(kind=1), value      :: c
+    print *, "by value(kind=1): ", c
+    if (c /= x)   stop 1
+    c = "*"
+    if (c /= "*") stop 2
+  end
+
+  subroutine val4 (x, c)
+    character(kind=4), intent(in) :: x  ! control: pass by reference
+    character(kind=4), value      :: c
+    print *, "by value(kind=4): ", c
+    if (c /= x)     stop 3
+    c = 4_"#"
+    if (c /= 4_"#") stop 4
+  end
+
+  subroutine sub (s)
+    character(*), intent(in) :: s
+    call val (s, s)
+  end
+  subroutine sub4 (s)
+    character(kind=4,len=*), intent(in) :: s
+    call val4 (s, s)
+  end
+
+  character function mychar (i)
+    integer, intent(in) :: i
+    mychar = char (i)
+  end
+end
--
2.35.3