From patchwork Wed Jan 4 18:29:55 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 134314 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 2A0221007D6 for ; Thu, 5 Jan 2012 05:30:33 +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=1326306634; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: From:To:Subject:Date:User-Agent:Cc:References:In-Reply-To: MIME-Version:Content-Type:Message-Id:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=8PnznBBhjfcIqP9J/zZOSHLUQq0=; b=YfFX1JfGZuBlFTx D4Xx+/jnS96iYF7tq5ZQtnR4vib7IVBOfFvBhC4DcE0CS8FFa1s7lsr2UbN0Z7kh ZBc1og+zxX3172y5P9dqzY88tqhxeRdIjCydXIkagZKTDEmHwQdOOpk3qQQA9f65 +/3iWC5nVJxHtzCFld9qdp1w0XeI= 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:X-SFR-UUID:From:To:Subject:Date:User-Agent:Cc:References:In-Reply-To:MIME-Version:X-UID:Content-Type:Message-Id:X-sfr-mailing:X-IsSubscribed:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=GNrFFi0qq5PHOe53kOnBsKLMfEPO4IZ5i5gLOVlWLSmBDo45OMq2kBrItAR19x t9sRKlsIeXxZhgLyJONI7Y9UazVPMH0SDjcG3MW6+MkA8LelkEKYOjJ7uNClk01M 11aOAqPpNWb0GkRb6tTLxB7CHQKShV4jCtPJNcXM0xV5E=; Received: (qmail 1291 invoked by alias); 4 Jan 2012 18:30:26 -0000 Received: (qmail 1268 invoked by uid 22791); 4 Jan 2012 18:30:24 -0000 X-SWARE-Spam-Status: No, hits=-2.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp22.services.sfr.fr (HELO smtp22.services.sfr.fr) (93.17.128.13) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 04 Jan 2012 18:30:04 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2217.sfr.fr (SMTP Server) with ESMTP id EAEB970001F2; Wed, 4 Jan 2012 19:30:02 +0100 (CET) Received: from gimli.local (167.183.72.86.rev.sfr.net [86.72.183.167]) by msfrf2217.sfr.fr (SMTP Server) with ESMTP id 63EE570001B4; Wed, 4 Jan 2012 19:30:02 +0100 (CET) X-SFR-UUID: 20120104183002409.63EE570001B4@msfrf2217.sfr.fr From: Mikael Morin To: fortran@gcc.gnu.org Subject: Re: [Patch, fortran] PR fortran/50981 segmentation fault when trying to access absent elemental actual arg Date: Wed, 4 Jan 2012 19:29:55 +0100 User-Agent: KMail/1.13.5 (FreeBSD/8.2-PRERELEASE; KDE/4.5.5; amd64; ; ) Cc: Tobias Burnus , gcc-patches@gcc.gnu.org References: <4EFF4557.6000403@sfr.fr> <4F019304.6040902@net-b.de> In-Reply-To: <4F019304.6040902@net-b.de> MIME-Version: 1.0 X-UID: 382 Message-Id: <201201041929.56591.mikael.morin@sfr.fr> 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 On Monday 02 January 2012 12:20:36 Tobias Burnus wrote: > Hello Mikael, > > Mikael Morin wrote: > > Regression tested on x86_64-unknown-linux-gnu. OK for 4.7/4.6/4.5[/4.4] ? > > OK - thanks for the comprehensive patch explanation and for the patch > itself. > > > + else > > + { > > + /* Otherwise, evaluate the argument out of the loop and pass > > + a reference to the value. */ > > + gfc_conv_expr (&se, expr); > > s/out of/outside/ Fixed > > > + if (dummy_arg != NULL > > + && dummy_arg->sym->attr.optional > > + && arg->expr I removed that one as it is guarded by: if (!arg->expr) continue; > > + && arg->expr->symtree > > + && arg->expr->symtree->n.sym->attr.optional > > + && arg->expr->ref == NULL) > > + newss->info->data.scalar.can_be_null_ref = true; > > I wonder whether one needs to take special care for the following > Fortran 2008 feature: "A null pointer can be used to denote an absent > nonallocatable nonpoin- > ter optional argument." - I guess, one doesn't. > I think there is an issue. I will look at it separately. Mikael Index: testsuite/gfortran.dg/elemental_optional_args_2.f90 =================================================================== --- testsuite/gfortran.dg/elemental_optional_args_2.f90 (révision 0) +++ testsuite/gfortran.dg/elemental_optional_args_2.f90 (révision 182875) @@ -0,0 +1,80 @@ +! { dg-do run } +! +! PR fortran/50981 +! The program used to dereference a NULL pointer when trying to access +! an optional dummy argument to be passed to an elemental subprocedure. +! +! Original testcase from Andriy Kostyuk + +PROGRAM test + IMPLICIT NONE + REAL(KIND=8), DIMENSION(2) :: aa, rr + + aa(1)=10. + aa(2)=11. + + + ! WRITE(*,*) 'Both f1 and ff work if the optional parameter is present:' + + rr=f1(aa,1) + ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2) + IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT + + rr=0 + rr=ff(aa,1) + ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2) + IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT + + + ! WRITE(*,*) 'But only f1 works if the optional parameter is absent:' + + rr=0 + rr=f1(aa) + ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2) + IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT + + rr = 0 + rr=ff(aa) + ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2) + IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT + + +CONTAINS + + ELEMENTAL REAL(KIND=8) FUNCTION ff(a,b) + IMPLICIT NONE + REAL(KIND=8), INTENT(IN) :: a + INTEGER, INTENT(IN), OPTIONAL :: b + REAL(KIND=8), DIMENSION(2) :: ac + ac(1)=a + ac(2)=a**2 + ff=SUM(gg(ac,b)) + END FUNCTION ff + + ELEMENTAL REAL(KIND=8) FUNCTION f1(a,b) + IMPLICIT NONE + REAL(KIND=8), INTENT(IN) :: a + INTEGER, INTENT(IN), OPTIONAL :: b + REAL(KIND=8), DIMENSION(2) :: ac + ac(1)=a + ac(2)=a**2 + f1=gg(ac(1),b)+gg(ac(2),b) ! This is the same as in ff, but without using the elemental feature of gg + END FUNCTION f1 + + ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b) + IMPLICIT NONE + REAL(KIND=8), INTENT(IN) :: a + INTEGER, INTENT(IN), OPTIONAL :: b + INTEGER ::b1 + IF(PRESENT(b)) THEN + b1=b + ELSE + b1=1 + ENDIF + gg=a**b1 + END FUNCTION gg + + +END PROGRAM test + + Index: testsuite/ChangeLog =================================================================== --- testsuite/ChangeLog (révision 182874) +++ testsuite/ChangeLog (révision 182875) @@ -1,3 +1,7 @@ +2012-01-04 Mikael Morin + + * gfortran.dg/elemental_optional_args_2.f90: New test. + 2012-01-04 Thomas Koenig PR fortran/49693 Index: fortran/trans-array.c =================================================================== --- fortran/trans-array.c (révision 182874) +++ fortran/trans-array.c (révision 182875) @@ -8307,12 +8307,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; @@ -8320,6 +8324,28 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc 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) { @@ -8333,6 +8359,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc 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->symtree + && arg->expr->symtree->n.sym->attr.optional + && arg->expr->ref == NULL) + newss->info->data.scalar.can_be_null_ref = true; } else scalar = 0; @@ -8344,6 +8377,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc while (tail->next != gfc_ss_terminator) tail = tail->next; } + + if (dummy_arg != NULL) + dummy_arg = dummy_arg->next; } if (scalar) @@ -8393,7 +8429,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * ex 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. */ Index: fortran/trans-array.h =================================================================== --- fortran/trans-array.h (révision 182874) +++ fortran/trans-array.h (révision 182875) @@ -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 *); Index: fortran/ChangeLog =================================================================== --- fortran/ChangeLog (révision 182874) +++ fortran/ChangeLog (révision 182875) @@ -1,6 +1,17 @@ 2012-01-04 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. + +2012-01-04 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. Index: fortran/trans-stmt.c =================================================================== --- fortran/trans-stmt.c (révision 182874) +++ fortran/trans-stmt.c (révision 182875) @@ -348,7 +348,8 @@ gfc_trans_call (gfc_code * code, bool dependency_c 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) Index: fortran/trans-intrinsic.c =================================================================== --- fortran/trans-intrinsic.c (révision 182874) +++ fortran/trans-intrinsic.c (révision 182875) @@ -7149,7 +7149,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_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;