From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp06.smtpout.orange.fr [80.12.242.128]) by sourceware.org (Postfix) with ESMTPS id 2CDB13959E5B for ; Tue, 3 Aug 2021 15:39:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 2CDB13959E5B Received: from cyrano.home ([92.167.144.168]) by mwinf5d37 with ME id d3fl250063eCq5G033frDc; Tue, 03 Aug 2021 17:39:52 +0200 X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Tue, 03 Aug 2021 17:39:52 +0200 X-ME-IP: 92.167.144.168 From: Mikael Morin To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org, Mikael Morin Subject: [PATCH 3/7] fortran: Reverse actual vs dummy argument mapping Date: Tue, 3 Aug 2021 17:39:41 +0200 Message-Id: <20210803153945.1309734-4-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.30.2 In-Reply-To: <20210803153945.1309734-1-mikael@gcc.gnu.org> References: <20210803153945.1309734-1-mikael@gcc.gnu.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------2.30.2" Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NEUTRAL, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 03 Aug 2021 15:39:55 -0000 This is a multi-part message in MIME format. --------------2.30.2 Content-Type: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding: 8bit There was originally no way from an actual argument to get to the corresponding dummy argument, even if the job of sorting and matching actual with dummy arguments was done. The closest was a field named actual in gfc_intrinsic_arg that was used as scratch data when sorting arguments of one specific call. However that value was overwritten later on as arguments of another call to the same procedure were sorted and matched. This change removes that field and adds instead a new field associated_dummy in gfc_actual_arglist. This field uses the just introduced gfc_dummy_arg interface, which makes it usable with both external and intrinsic procedure dummy arguments. As the removed field was used in the code sorting and matching arguments, that code has to be updated. Two local vectors with matching indices are introduced for respectively dummy and actual arguments, and the loops are modified to use indices and update those argument vectors. gcc/fortran/ * gfortran.h (gfc_actual_arglist): New field associated_dummy. (gfc_intrinsic_arg): Remove field actual. * interface.c (gfc_compare_actual): Initialize associated_dummy. * intrinsic.c (sort_actual):  Add argument vectors. Use loops with indices on argument vectors. Initialize associated_dummy. --- gcc/fortran/gfortran.h | 6 +++++- gcc/fortran/interface.c | 9 +++++++-- gcc/fortran/intrinsic.c | 31 ++++++++++++++++++++----------- 3 files changed, 32 insertions(+), 14 deletions(-) --------------2.30.2 Content-Type: text/x-patch; name="0003-fortran-Reverse-actual-vs-dummy-argument-mapping.patch" Content-Transfer-Encoding: 8bit Content-Disposition: inline; filename="0003-fortran-Reverse-actual-vs-dummy-argument-mapping.patch" diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 031e46d1457..78b43a31a9a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1168,6 +1168,11 @@ typedef struct gfc_actual_arglist gfc_param_spec_type spec_type; struct gfc_expr *expr; + + /* The dummy arg this actual arg is associated with, if the interface + is explicit. NULL otherwise. */ + gfc_dummy_arg *associated_dummy; + struct gfc_actual_arglist *next; } gfc_actual_arglist; @@ -2174,7 +2179,6 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg gfc_typespec ts; unsigned optional:1, value:1; ENUM_BITFIELD (sym_intent) intent:2; - gfc_actual_arglist *actual; struct gfc_intrinsic_arg *next; }; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9e3e8aa9da9..b763f87e8bd 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3131,6 +3131,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "call at %L", where); return false; } + else + a->associated_dummy = f; if (a->expr == NULL) { @@ -3546,9 +3548,12 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* The argument lists are compatible. We now relink a new actual argument list with null arguments in the right places. The head of the list remains the head. */ - for (i = 0; i < n; i++) + for (f = formal, i = 0; f; f = f->next, i++) if (new_arg[i] == NULL) - new_arg[i] = gfc_get_actual_arglist (); + { + new_arg[i] = gfc_get_actual_arglist (); + new_arg[i]->associated_dummy = f; + } if (na != 0) { diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 2b7b72f03e2..ef5da389434 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4290,8 +4290,14 @@ sort_actual (const char *name, gfc_actual_arglist **ap, remove_nullargs (ap); actual = *ap; + auto_vec dummy_args; + auto_vec ordered_actual_args; + for (f = formal; f; f = f->next) - f->actual = NULL; + dummy_args.safe_push (f); + + ordered_actual_args.safe_grow_cleared (dummy_args.length (), + /* exact = */true); f = formal; a = actual; @@ -4343,7 +4349,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, } } - for (;;) + for (int i = 0;; i++) { /* Put the nonkeyword arguments in a 1:1 correspondence */ if (f == NULL) break; @@ -4353,7 +4359,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, if (a->name != NULL) goto keywords; - f->actual = a; + ordered_actual_args[i] = a; f = f->next; a = a->next; @@ -4371,7 +4377,8 @@ keywords: to be keyword arguments. */ for (; a; a = a->next) { - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) if (strcmp (a->name, f->name) == 0) break; @@ -4386,21 +4393,21 @@ keywords: return false; } - if (f->actual != NULL) + if (ordered_actual_args[idx] != NULL) { gfc_error ("Argument %qs appears twice in call to %qs at %L", f->name, name, where); return false; } - - f->actual = a; + ordered_actual_args[idx] = a; } optional: /* At this point, all unmatched formal args must be optional. */ - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - if (f->actual == NULL && f->optional == 0) + if (ordered_actual_args[idx] == NULL && f->optional == 0) { gfc_error ("Missing actual argument %qs in call to %qs at %L", f->name, name, where); @@ -4413,9 +4420,9 @@ do_sort: together in a way that corresponds with the formal list. */ actual = NULL; - for (f = formal; f; f = f->next) + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - a = f->actual; + a = ordered_actual_args[idx]; if (a && a->label != NULL && f->ts.type) { gfc_error ("ALTERNATE RETURN not permitted at %L", where); @@ -4428,6 +4435,8 @@ do_sort: a->missing_arg_type = f->ts.type; } + a->associated_dummy = f; + if (actual == NULL) *ap = a; else --------------2.30.2--