From: Mikael Morin <[email protected]>

Fortran-tested on aarch64-unknown-linux-gnu.  OK for mainline?

-- >8 --

Explicitly pass false as `formal_ptr' argument to gfc_conv_subref_array_arg.

The function gfc_conv_subref_array_arg implements copy-in/copy-out for
argument association.  It has a `formal_ptr' argument indicating whether the
dummy has the pointer attribute.  But copy-in/copy-out is used in contexts
where we can exclude any pointer dummy, so the argument can be guessed to be
false.  In this change, every hunk is independant of each other and has a
specific context reasoning permitting the replacement of the argument by an
explicit false.

In gfc_conv_gfc_desc_to_cfi_desc, if the dummy is assumed-size or explicit-
shape array, it must not have the pointer attribute (F2023, C834).
Otherwise, it is contiguous which for pointers requires the actual argument
to be simply contiguous (F2023, C1550).  But the actual argument isn't in
the context of the call, so the dummy must not have the pointer attribute.

In the first gfc_conv_procedure_call hunk, the condition used as argument
is explicitly used negated in the guarding condition before.

In the two next gfc_conv_procedure_call hunks, the actual argument is
polymorphic and associated with a non-polymorphic derived type dummy.  But
that is explicitly disallowed for pointers, for which same declared type and
same polymorphicness are required (F2023, 15.5.2.6).  So the dummy must not
have the pointer attribute.

In the last gfc_conv_procedure_call hunk, the dummy has the contiguous
attribute, which for pointers requires the actual argument to be simply
contiguous (F2023, C1550).  But the actual argument isn't, so the dummy must
not have the pointer attribute.

In the trans_associate_var function, the symbol is an associate name, so it
doesn't have the pointer attribute (F2023, 11.1.3.3).

gcc/fortran/ChangeLog:

        * trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc,
        gfc_conv_procedure_call): Explicitly pass false as `formal_ptr'
        argument to gfc_conv_subref_array_arg.
        * trans-stmt.cc (trans_associate_var): Likewise.
---
 gcc/fortran/trans-expr.cc | 16 ++++++----------
 gcc/fortran/trans-stmt.cc |  3 +--
 2 files changed, 7 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a2b8f12ede3..9ebab865210 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6248,9 +6248,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr 
*e, gfc_symbol *fsym)
          bool optional = fsym->attr.optional;
          fsym->attr.optional = 0;
          gfc_conv_subref_array_arg (&se, e, false, fsym->attr.intent,
-                                    fsym->attr.pointer, fsym,
-                                    fsym->ns->proc_name->name, NULL,
-                                    /* check_contiguous= */ true);
+                                    false, fsym, fsym->ns->proc_name->name,
+                                    NULL, /* check_contiguous= */ true);
          fsym->attr.optional = optional;
        }
       else
@@ -8323,8 +8322,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                  bool whole_span = is_whole_span_addressed_dummy (e);
                  gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
                                fsym ? fsym->attr.intent : INTENT_INOUT,
-                               fsym && fsym->attr.pointer, fsym, sym->name,
-                               NULL, whole_span, false,
+                               false, fsym, sym->name, NULL, whole_span, false,
                                whole_span
                                && dummy_accepts_strided_arg (fsym,
                                                              nodesc_arg));
@@ -8347,8 +8345,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                   is converted to a temporary, which is passed and then
                   written back after the procedure call.  */
                gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
-                                          fsym->attr.intent,
-                                          fsym->attr.pointer);
+                                          fsym->attr.intent, false);
 
              else if (gfc_is_class_array_function (e)
                       && fsym && fsym->ts.type == BT_DERIVED
@@ -8359,7 +8356,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                {
                  e->must_finalize = 1;
                  gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
-                                            INTENT_IN, fsym->attr.pointer);
+                                            INTENT_IN, false);
                }
              else if (fsym && fsym->attr.contiguous
                       && (fsym->attr.target
@@ -8369,8 +8366,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                       && e->rank != -1)
                {
                  gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
-                                            fsym->attr.intent,
-                                            fsym->attr.pointer);
+                                            fsym->attr.intent, false);
                }
              else
                {
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 2a87176ffa9..6f515753740 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2063,8 +2063,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
       gfc_se init;
       gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)));
       gfc_init_se (&init, NULL);
-      gfc_conv_subref_array_arg (&init, e, false, INTENT_INOUT,
-                                sym && sym->attr.pointer);
+      gfc_conv_subref_array_arg (&init, e, false, INTENT_INOUT, false);
       init.expr = build_fold_indirect_ref_loc (input_location, init.expr);
       gfc_add_modify (&init.pre, sym->backend_decl, init.expr);
       gfc_add_init_cleanup (block, gfc_finish_block (&init.pre),
-- 
2.53.0

Reply via email to