fortran: Fix length one character dummy arg type [PR110419]

Revision r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa
changed the argument passing convention for length 1 value dummy
arguments to pass just the single character by value.  However, the
procedure declarations weren't updated to reflect the change in the
argument types.
This change does the missing argument type update.

The change of argument types generated an internal error in
gfc_conv_string_parameter with value_9.f90.  Indeed, that function is
not prepared for bare character type, so it is updated as well.

The condition guarding the single character argument passing code
is loosened to not exclude non-interoperable kind (this fixes
a regression with c_char_tests_2.f03).

Finally, the constant string argument passing code is updated as well
to extract the single char and pass it instead of passing it as
a length one string.  As the code taking care of non-constant arguments
was already doing this, the condition guarding it is just removed.

With these changes, value_9.f90 passes on 32 bits big-endian powerpc.

	PR fortran/110360
	PR fortran/110419

gcc/fortran/ChangeLog:

	* trans-types.cc (gfc_sym_type): Use a bare character type for length
	one value character dummy arguments.
	* trans-expr.cc (gfc_conv_string_parameter): Handle single character
	case.
	(gfc_conv_procedure_call): Don't exclude interoperable kinds
	from single character handling.  For single character dummy arguments,
	extend the existing handling of non-constant expressions to constant
	expressions.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bind_c_usage_13.f03: Update tree dump patterns.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9c73b7e478598de460ce05cdae7550b57dc75999..52cd88f5b0079a3c18795e149f5128c78dfece32 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6451,26 +6451,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
                    /* ABI: actual arguments to CHARACTER(len=1),VALUE
                       dummy arguments are actually passed by value.
-                      Strings are truncated to length 1.
-                      The BIND(C) case is handled elsewhere.  */
-                   if (!fsym->ts.is_c_interop
-                       && gfc_length_one_character_type_p (&fsym->ts))
+                      Strings are truncated to length 1.  */
+                   if (gfc_length_one_character_type_p (&fsym->ts))
                      {
-                       if (e->expr_type != EXPR_CONSTANT)
-                         {
-                           tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
-                           gfc_conv_string_parameter (&parmse);
-                           parmse.expr = gfc_string_to_single_character (slen1,
-                                                                         parmse.expr,
-                                                                         e->ts.kind);
-                           /* Truncate resulting string to length 1.  */
-                           parmse.string_length = slen1;
-                         }
-                       else if (e->value.character.length > 1)
+                       if (e->expr_type == EXPR_CONSTANT
+                           && e->value.character.length > 1)
                          {
                            e->value.character.length = 1;
                            gfc_conv_expr (&parmse, e);
                          }
+
+                       tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
+                       gfc_conv_string_parameter (&parmse);
+                       parmse.expr
+                           = gfc_string_to_single_character (slen1,
+                                                             parmse.expr,
+                                                             e->ts.kind);
+                       /* Truncate resulting string to length 1.  */
+                       parmse.string_length = slen1;
                      }
 
                    if (fsym->attr.optional
@@ -10611,6 +10609,13 @@ gfc_conv_string_parameter (gfc_se * se)
 {
   tree type;
 
+  if (TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE
+      && integer_onep (se->string_length))
+    {
+      se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+      return;
+    }
+
   if (TREE_CODE (se->expr) == STRING_CST)
     {
       type = TREE_TYPE (TREE_TYPE (se->expr));

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 987e3d26c4630825552c0162c15e228a1de60fc8..084b8c3ae2cdadaf3bdc8ac3d5194c58a9b9f61c 100644 (file)
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2313,7 +2313,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
              && sym->ns->proc_name
              && sym->ns->proc_name->attr.is_bind_c)
          || (sym->ts.deferred && (!sym->ts.u.cl
-                                  || !sym->ts.u.cl->backend_decl))))
+                                  || !sym->ts.u.cl->backend_decl))
+         || (sym->attr.dummy
+             && sym->attr.value
+             && gfc_length_one_character_type_p (&sym->ts))))
     type = gfc_get_char_type (sym->ts.kind);
   else
     type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
index 470bd59ed3839340d2e48d71b0801c50840e1a4e..3cc9f8e0fe9ad284ed5c271f047d027dd4495da6 100644 (file)
--- a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
@@ -130,9 +130,9 @@ end program test
 ! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
 ! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
 !
-! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }
+! { dg-final { scan-tree-dump "mult_val .120, 120, 1, 1.;" "original" } }
 ! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }
-! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }
+! { dg-final { scan-tree-dump "multiso2_val .122, 120.;" "original" } }
 !
 ! Single argument dump:
 !
@@ -144,7 +144,7 @@ end program test
 ! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }
 ! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }
 !
-! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }
+! { dg-final { scan-tree-dump "sub_val .120, 1.;" "original" } }
 ! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }
-! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }
+! { dg-final { scan-tree-dump "subiso2_val .122.;" "original" } }
 !