[PATCH] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825]

[Harald Anlauf <anlauf@gmx.de>]

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

Dear all,

when passing a character actual argument to an assumed-type dummy
(TYPE(*)), we should not pass the character length for that argument,
as otherwise other hidden arguments that are passed as part of the
gfortran ABI will not be interpreted correctly.  This is in line
with the current way the procedure decl is generated.

The attached patch fixes the caller and clarifies the behavior
in the documentation.

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

Thanks,
Harald


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

From 199e09c9862f5afe7e583839bc1b108c741a7efb Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 27 Jul 2023 21:30:26 +0200
Subject: [PATCH] Fortran: do not pass hidden character length for TYPE(*)
 dummy [PR110825]

gcc/fortran/ChangeLog:

	PR fortran/110825
	* gfortran.texi: Clarify argument passing convention.
	* trans-expr.cc (gfc_conv_procedure_call): Do not pass the character
	length as hidden argument when the declared dummy argument is
	assumed-type.

gcc/testsuite/ChangeLog:

	PR fortran/110825
	* gfortran.dg/assumed_type_18.f90: New test.
---
 gcc/fortran/gfortran.texi                     |  3 +-
 gcc/fortran/trans-expr.cc                     |  1 +
 gcc/testsuite/gfortran.dg/assumed_type_18.f90 | 52 +++++++++++++++++++
 3 files changed, 55 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/assumed_type_18.f90

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 7786d23265f..f476a3719f5 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3750,7 +3750,8 @@ front ends of GCC, e.g. to GCC's C99 compiler for @code{_Bool}
 or GCC's Ada compiler for @code{Boolean}.)

 For arguments of @code{CHARACTER} type, the character length is passed
-as a hidden argument at the end of the argument list.  For
+as a hidden argument at the end of the argument list, except when the
+corresponding dummy argument is declared as @code{TYPE(*)}.  For
 deferred-length strings, the value is passed by reference, otherwise
 by value.  The character length has the C type @code{size_t} (or
 @code{INTEGER(kind=C_SIZE_T)} in Fortran).  Note that this is
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ef3e6d08f78..764565476af 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7521,6 +7521,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  && !(fsym && fsym->ts.type == BT_DERIVED && fsym->ts.u.derived
 	       && fsym->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
 	       && fsym->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING )
+	  && !(fsym && fsym->ts.type == BT_ASSUMED)
 	  && !(fsym && UNLIMITED_POLY (fsym)))
 	vec_safe_push (stringargs, parmse.string_length);

diff --git a/gcc/testsuite/gfortran.dg/assumed_type_18.f90 b/gcc/testsuite/gfortran.dg/assumed_type_18.f90
new file mode 100644
index 00000000000..a3d791919a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_18.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! PR fortran/110825 - TYPE(*) and character actual arguments
+
+program foo
+  use iso_c_binding, only: c_loc, c_ptr, c_associated
+  implicit none
+  character(100)            :: not_used = ""
+  character(:), allocatable :: deferred
+  character                 :: c42(6,7) = "*"
+  call sub  (not_used,  "123")
+  call sub  ("0"      , "123")
+  deferred = "d"
+  call sub  (deferred , "123")
+  call sub2 ([1.0,2.0], "123")
+  call sub2 (["1","2"], "123")
+  call sub3 (c42      , "123")
+
+contains
+
+  subroutine sub (useless_var, print_this)
+    type(*),      intent(in) :: useless_var
+    character(*), intent(in) :: print_this
+    if (len      (print_this) /= 3) stop 1
+    if (len_trim (print_this) /= 3) stop 2
+  end
+
+  subroutine sub2 (a, c)
+    type(*),      intent(in) :: a(:)
+    character(*), intent(in) :: c
+    if (len      (c) /= 3) stop 10
+    if (len_trim (c) /= 3) stop 11
+    if (size (a)     /= 2) stop 12
+  end
+
+  subroutine sub3 (a, c)
+    type(*),      intent(in), target, optional :: a(..)
+    character(*), intent(in)                   :: c
+    type(c_ptr) :: cpt
+    if (len      (c) /= 3) stop 20
+    if (len_trim (c) /= 3) stop 21
+    if (.not. present (a)) stop 22
+    if (rank (a)     /= 2) stop 23
+    if (size (a)    /= 42) stop 24
+    if (any (shape  (a) /= [6,7])) stop 25
+    if (any (lbound (a) /= [1,1])) stop 26
+    if (any (ubound (a) /= [6,7])) stop 27
+    if (.not. is_contiguous (a))   stop 28
+    cpt = c_loc (a)
+    if (.not. c_associated (cpt))  stop 29
+  end
+
+end
--
2.35.3