public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gmx.de>
To: fortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [PATCH] Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]
Date: Thu, 22 Jun 2023 22:23:24 +0200	[thread overview]
Message-ID: <trinity-67cbfb46-d186-40df-86e8-fb36979a34a9-1687465404920@3c-app-gmx-bs06> (raw)

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

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


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

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


             reply	other threads:[~2023-06-22 20:23 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-06-22 20:23 Harald Anlauf [this message]
2023-06-23  8:04 ` Mikael Morin

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=trinity-67cbfb46-d186-40df-86e8-fb36979a34a9-1687465404920@3c-app-gmx-bs06 \
    --to=anlauf@gmx.de \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).