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 --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 7786d23265f2d52487d5d12fae2f9e526e8260c0..f476a3719f557789cc4e5e305f8edabb6f4db95a 100644 (file)
--- 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 ef3e6d08f789d147519b820c32a06313df0f8a64..764565476af2dd5db4e81a6fb4e6ded976d40019 100644 (file)
--- 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 (file)
index 0000000..a3d7919
--- /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