From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) by sourceware.org (Postfix) with ESMTPS id 97503395ACC9 for ; Tue, 3 Aug 2021 15:39:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 97503395ACC9 Received: from smtp06.smtpout.orange.fr ([80.12.242.128]:21051 helo=smtp.smtpout.orange.fr) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:128) (Exim 4.90_1) (envelope-from ) id 1mAwWJ-00036b-Af for fortran@gcc.gnu.org; Tue, 03 Aug 2021 11:39:58 -0400 Received: from cyrano.home ([92.167.144.168]) by mwinf5d37 with ME id d3fl250063eCq5G033ftDy; Tue, 03 Aug 2021 17:39:53 +0200 X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Tue, 03 Aug 2021 17:39:53 +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 7/7] fortran: Ignore unused args in scalarization [PR97896] Date: Tue, 3 Aug 2021 17:39:45 +0200 Message-Id: <20210803153945.1309734-8-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 Received-SPF: neutral client-ip=80.12.242.128; envelope-from=mikael@gcc.gnu.org; helo=smtp.smtpout.orange.fr X-Spam_score_int: 18 X-Spam_score: 1.8 X-Spam_bar: + X-Spam_report: (1.8 / 5.0 requ) PP_MIME_FAKE_ASCII_TEXT=0.998, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_NEUTRAL=0.779 autolearn=no autolearn_force=no X-Spam_action: no action X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, KAM_STOCKGEN, PP_MIME_FAKE_ASCII_TEXT, SPF_HELO_PASS, SPF_NEUTRAL, TXREP autolearn=unavailable autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 03 Aug 2021 15:40:00 -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 The KIND argument of the INDEX intrinsic is a compile time constant that is used at compile time only to resolve to a kind-specific library method. It is otherwise completely ignored at runtime, and there is no code generated for it as the library procedure has no kind argument. This confuses the scalarizer which expects to see every argument of elemental functions to be used when calling a procedure. This change removes the argument from the scalarization lists at the beginning of the scalarization process, so that the argument is completely ignored. gcc/fortran/ PR fortran/97896 * gfortran.h (gfc_dummy_arg::get_name): New method. (gfc_formal_arglist::get_name, gfc_intrinsic_arg::get_name): Declare new methods. * symbol.c (gfc_formal_arglist::get_name): Implement new method. * intrinsic.c (gfc_intrinsic_arg::get_name): Same. * trans-array.h (gfc_get_intrinsic_for_expr, gfc_get_proc_ifc_for_expr): New. * trans-array.c (gfc_get_intrinsic_for_expr, arg_evaluated_for_scalarization): New. (gfc_walk_elemental_function_args): Add intrinsic procedure as argument. Check arg_evaluated_for_scalarization. * trans-intrinsic.c (gfc_walk_intrinsic_function): Update call. * trans-stmt.c (get_intrinsic_for_code): New. (gfc_trans_call): Update call. gcc/testsuite/ PR fortran/97896 * gfortran.dg/index_5.f90: New. --- gcc/fortran/gfortran.h | 3 ++ gcc/fortran/intrinsic.c | 6 +++ gcc/fortran/symbol.c | 6 +++ gcc/fortran/trans-array.c | 53 ++++++++++++++++++++++++++- gcc/fortran/trans-array.h | 3 ++ gcc/fortran/trans-intrinsic.c | 1 + gcc/fortran/trans-stmt.c | 20 ++++++++++ gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++++ 8 files changed, 114 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90 --------------2.30.2 Content-Type: text/x-patch; name="0007-fortran-Ignore-unused-args-in-scalarization-PR97896.patch" Content-Transfer-Encoding: 8bit Content-Disposition: inline; filename="0007-fortran-Ignore-unused-args-in-scalarization-PR97896.patch" diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 627a3480ef1..6d9af76c9fc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1136,6 +1136,7 @@ gfc_component; class gfc_dummy_arg { public: + virtual const char *get_name () const = 0; virtual const gfc_typespec & get_typespec () const = 0; virtual bool is_optional () const = 0; }; @@ -1149,6 +1150,7 @@ struct gfc_formal_arglist : public gfc_dummy_arg /* Points to the next formal argument. */ struct gfc_formal_arglist *next; + virtual const char *get_name () const FINAL OVERRIDE; virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE; virtual bool is_optional () const FINAL OVERRIDE; }; @@ -2183,6 +2185,7 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg struct gfc_intrinsic_arg *next; + virtual const char *get_name () const FINAL OVERRIDE; virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE; virtual bool is_optional () const FINAL OVERRIDE; }; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index b3e907ba3b8..af4da7ea7d3 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -5472,6 +5472,12 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func) } +const char * +gfc_intrinsic_arg::get_name () const +{ + return name; +} + const gfc_typespec & gfc_intrinsic_arg::get_typespec () const { diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 59f0d0385a0..9d1e2f876dc 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -5261,6 +5261,12 @@ gfc_sym_get_dummy_args (gfc_symbol *sym) } +const char * +gfc_formal_arglist::get_name () const +{ + return sym->name; +} + const gfc_typespec & gfc_formal_arglist::get_typespec () const { diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7d85abb181f..1fe48c22b93 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -11200,6 +11200,51 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) } +/* Given an expression referring to an intrinsic function call, + return the intrinsic symbol. */ + +gfc_intrinsic_sym * +gfc_get_intrinsic_for_expr (gfc_expr *call) +{ + if (call == NULL) + return NULL; + + /* Normal procedure case. */ + if (call->expr_type == EXPR_FUNCTION) + return call->value.function.isym; + else + return NULL; +} + + +/* Indicates whether an argument to an intrinsic function should be used in + scalarization. It is usually the case, except for some intrinsics + requiring the value to be constant, and using the value at compile time only. + As the value is not used at runtime in those cases, we don’t produce code + for it, and it should not be visible to the scalarizer. */ + +static bool +arg_evaluated_for_scalarization (gfc_intrinsic_sym *function, + gfc_dummy_arg *dummy_arg) +{ + if (function != NULL) + { + switch (function->id) + { + case GFC_ISYM_INDEX: + if (strcmp ("kind", dummy_arg->get_name ()) == 0) + return false; + /* Fallthrough. */ + + default: + break; + } + } + + return true; +} + + /* Walk the arguments of an elemental function. PROC_EXPR is used to check whether an argument is permitted to be absent. If it is NULL, we don't do the check and the argument is assumed to be present. @@ -11207,6 +11252,7 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, + gfc_intrinsic_sym *intrinsic_sym, gfc_ss_type type) { int scalar; @@ -11221,7 +11267,11 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, for (; arg; arg = arg->next) { gfc_dummy_arg * const dummy_arg = arg->associated_dummy; - if (!arg->expr || arg->expr->expr_type == EXPR_NULL) + if (!arg->expr + || arg->expr->expr_type == EXPR_NULL + || (dummy_arg + && intrinsic_sym + && !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg))) continue; newss = gfc_walk_subexpr (head, arg->expr); @@ -11310,6 +11360,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) ss = gfc_walk_elemental_function_args (old_ss, expr->value.function.actual, + gfc_get_intrinsic_for_expr (expr), GFC_SS_REFERENCE); if (ss != old_ss && (comp diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 998fd284dd6..19c2f765b9a 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -74,6 +74,8 @@ void gfc_trans_static_array_pointer (gfc_symbol *); /* Get the procedure interface for a function call. */ gfc_symbol *gfc_get_proc_ifc_for_expr (gfc_expr *); +/* Get the intrinsic symbol for an intrinsic function call. */ +gfc_intrinsic_sym *gfc_get_intrinsic_for_expr (gfc_expr *); /* Generate scalarization information for an expression. */ gfc_ss *gfc_walk_expr (gfc_expr *); /* Workhorse for gfc_walk_expr. */ @@ -82,6 +84,7 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *); gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref); /* Walk the arguments of an elemental function. */ gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, + gfc_intrinsic_sym *, gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 8a9283b358d..c2383119e5d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -11163,6 +11163,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, if (isym->elemental) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, + expr->value.function.isym, GFC_SS_SCALAR); if (expr->rank == 0) diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 3fd4475f411..2b9ca875ee5 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -356,6 +356,25 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, } +/* Given an executable statement referring to an intrinsic function call, + returns the intrinsic symbol. */ + +static gfc_intrinsic_sym * +get_intrinsic_for_code (gfc_code *code) +{ + if (code->op == EXEC_CALL) + { + gfc_intrinsic_sym * const isym = code->resolved_isym; + if (isym) + return isym; + else + return gfc_get_intrinsic_for_expr (code->expr1); + } + + return NULL; +} + + /* Translate the CALL statement. Builds a call to an F95 subroutine. */ tree @@ -381,6 +400,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, ss = gfc_ss_terminator; if (code->resolved_sym->attr.elemental) ss = gfc_walk_elemental_function_args (ss, code->ext.actual, + get_intrinsic_for_code (code), GFC_SS_REFERENCE); /* MVBITS is inlined but needs the dependency checking found here. */ diff --git a/gcc/testsuite/gfortran.dg/index_5.f90 b/gcc/testsuite/gfortran.dg/index_5.f90 new file mode 100644 index 00000000000..e039455d175 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/index_5.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! +! PR fortran/97896 +! An ICE occured with INDEX when the KIND argument was present +! because of a mismatch between the number of arguments expected +! during the scalarization process and the number of arguments actually +! used. +! +! Test contributed by Harald Anlauf , based on an initial +! submission by G. Steinmetz . + +program p + implicit none + logical :: a(2) + integer :: b(2) + integer(8) :: d(2) + b = index ('xyxyz','yx', back=a) + b = index ('xyxyz','yx', back=a, kind=4) + d = index ('xyxyz','yx', back=a, kind=8) + b = index ('xyxyz','yx', back=a, kind=8) + d = index ('xyxyz','yx', back=a, kind=4) +end + --------------2.30.2--