From 02f4ca0df2d69b922a622e7cc9b396cf686d5a0f 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 7786d23265f2..f476a3719f55 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 ef3e6d08f789..764565476af2 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 000000000000..a3d791919a2b
--- /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
--
GitLab