From patchwork Sat Dec 31 17:24:39 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 133743 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id B7124B6FB6 for ; Sun, 1 Jan 2012 04:26:57 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1325957219; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=KU+13ue gSQbz9eZrx37oe7uNCIs=; b=CRKYc7wcFzLMvk+NGqdOeL556XHbuBe8tK9m96v GTlIXFcXVdLBmOedUv1RNoG+uSotreimPLcUdwbgfuDJJH8aLo2Wl6B0n1tOnKhT QMFauIz3l44RhGfegqdAkTl3Ri3rezvpVTSpA097cVYXs5CbNoDPG2l0bsydoJoV FTtM= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:X-sfr-mailing:X-IsSubscribed:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=Sje6u8fajyghg3espmrE0+33+zU6iyFocYqfcoFWZu6kNl1cc8Yl04t8i1JNHE qESbGC7BkzwCIPyjXqo/3SdZ4Vn2YkBmDEUAL3oCePGNc5vUKQ4u0SmRgwZK4KRd tAe9Bu1akFGuSpVILaiYNaqlkZ+jn2J0nHyjuV5TRY52k=; Received: (qmail 8094 invoked by alias); 31 Dec 2011 17:26:53 -0000 Received: (qmail 8071 invoked by uid 22791); 31 Dec 2011 17:26:50 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL, BAYES_40, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp23.services.sfr.fr (HELO smtp23.services.sfr.fr) (93.17.128.20) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 31 Dec 2011 17:26:36 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2307.sfr.fr (SMTP Server) with ESMTP id 19E00700032F; Sat, 31 Dec 2011 18:26:33 +0100 (CET) Received: from [192.168.1.58] (167.183.72.86.rev.sfr.net [86.72.183.167]) by msfrf2307.sfr.fr (SMTP Server) with ESMTP id 75BC5700032D; Sat, 31 Dec 2011 18:26:31 +0100 (CET) Message-ID: <4EFF4557.6000403@sfr.fr> Date: Sat, 31 Dec 2011 18:24:39 +0100 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:8.0) Gecko/20111216 Thunderbird/8.0 MIME-Version: 1.0 To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [Patch, fortran] PR fortran/50981 segmentation fault when trying to access absent elemental actual arg X-sfr-mailing: LEGIT X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hello, as promised, here is a fix for pr50981. Currently, for a call to an elemental procedure, every scalar actual argument is evaluated before the loop containing the function call. The bug is, we can't evaluate the actual argument if it is a reference to an absent optional dummy argument, as it will result in a NULL pointer dereference. We must pass the reference directly in that case. To fix this, the call to gfc_conv_expr in gfc_add_loop_ss_code, must be changed to a call to gfc_conv_expr_reference. Such a change is basically a revert of PR43841's fix, so we are back with a missed optimization bug. To avoid this we have to do the change only when it is necessary, i.e. when the dummy argument is optional and the actual argument is a reference to an optional dummy. This information is not available in gfc_add_loop_ss_code, so I make for it a new field can_be_null_ref in the gfc_ss_info struct: this is the second patch. Then, the third patch is about setting that field: as the dummy argument information isn't either available in gfc_walk_elemental_function_args, a new argument, proc_expr, is added, which holds the reference to the procedure. It is of type gfc_expr* so that it can handle direct calls and type-bound calls equally well. The first patch is for consistency: gfc_conv_expr should return values, not references, so the address taking is moved where it is actually requested (in gfc_conv_expr_reference). Regression tested on x86_64-unknown-linux-gnu. OK for 4.7/4.6/4.5[/4.4] ? Mikael. PS: Greetings for the new year. 2011-12-29 Mikael Morin * trans-expr.c (gfc_conv_expr): Move address taking... (gfc_conv_expr_reference): ... here. 2011-12-29 Mikael Morin PR fortran/50981 * trans.h (struct gfc_ss_info): New field data::scalar::can_be_null_ref * trans-array.c: If the reference can be NULL, save the reference instead of the value. * trans-expr.c (gfc_conv_expr): If we have saved a reference, dereference it. 2011-12-29 Mikael Morin PR fortran/50981 * trans-array.h (gfc_walk_elemental_function_args): New argument. * trans-intrinsic.c (gfc_walk_intrinsic_function): Update call. * trans-stmt.c (gfc_trans_call): Ditto. * trans-array.c (gfc_walk_function_expr): Ditto. (gfc_walk_elemental_function_args): Get the dummy argument list if possible. Check that the dummy and the actual argument are both optional, and set can_be_null_ref accordingly. 2011-12-29 Mikael Morin * elemental_optional_args_2.f90: New test. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 19e081b..f8aece6 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8295,12 +8295,16 @@ gfc_reverse_ss (gfc_ss * ss) } -/* Walk the arguments of an elemental function. */ +/* 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. +*/ gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, - gfc_ss_type type) + gfc_expr *proc_expr, gfc_ss_type type) { + gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; gfc_ss *tail; @@ -8308,6 +8312,28 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; + + if (proc_expr) + { + gfc_ref *ref; + + /* Normal procedure case. */ + dummy_arg = proc_expr->symtree->n.sym->formal; + + /* Typebound procedure case. */ + for (ref = proc_expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT + && ref->u.c.component->attr.proc_pointer + && ref->u.c.component->ts.interface) + dummy_arg = ref->u.c.component->ts.interface->formal; + else + dummy_arg = NULL; + } + } + else + dummy_arg = NULL; + scalar = 1; for (; arg; arg = arg->next) { @@ -8321,6 +8347,14 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE); newss = gfc_get_scalar_ss (head, arg->expr); newss->info->type = type; + + if (dummy_arg != NULL + && dummy_arg->sym->attr.optional + && arg->expr + && arg->expr->symtree + && arg->expr->symtree->n.sym->attr.optional + && arg->expr->ref == NULL) + newss->info->data.scalar.can_be_null_ref = true; } else scalar = 0; @@ -8332,6 +8366,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, while (tail->next != gfc_ss_terminator) tail = tail->next; } + + if (dummy_arg != NULL) + dummy_arg = dummy_arg->next; } if (scalar) @@ -8381,7 +8418,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) by reference. */ if (sym->attr.elemental || (comp && comp->attr.elemental)) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, - GFC_SS_REFERENCE); + expr, GFC_SS_REFERENCE); /* Scalar functions are OK as these are evaluated outside the scalarization loop. Pass back and let the caller deal with it. */ diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 340c1a7..19cfac5 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -73,7 +73,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_ss_type); + gfc_expr *, gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 5c964c1..900d546 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7145,7 +7145,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, - GFC_SS_SCALAR); + NULL, GFC_SS_SCALAR); if (expr->rank == 0) return ss; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 9e903d8..92f7f43 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -348,7 +348,8 @@ 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, GFC_SS_REFERENCE); + ss = gfc_walk_elemental_function_args (ss, code->ext.actual, + code->expr1, GFC_SS_REFERENCE); /* Is not an elemental subroutine call with array valued arguments. */ if (ss == gfc_ss_terminator)