[gcc r14-2856] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825]

[gcc r14-2856] Fortran: do not pass hidden character length for TYPE(*) dummy [PR110825]

[Harald Anlauf]

https://gcc.gnu.org/g:02f4ca0df2d69b922a622e7cc9b396cf686d5a0f

commit r14-2856-g02f4ca0df2d69b922a622e7cc9b396cf686d5a0f
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Thu Jul 27 21:30:26 2023 +0200

    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.

Diff:
---
 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(-)

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