From patchwork Sun Feb 12 18:55:02 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 140822 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 A2169B6FA7 for ; Mon, 13 Feb 2012 05:55:32 +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=1329677733; 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=R+oKmfw B0TCX/mF61ToUexIqOVs=; b=FjWglznlJ6mr2oIwwDerUnzL5RHJYDHVkIxX0ZZ ZGF1PGbX3ITq2sXyskNmKhhvp9Kw46JMUp5uun9P+UqhYnQTHVdwCiruU3dH/DNU 5mBqP8HsG7xd/fq8nYAaQ17Kz+bEr9tAOmPELvUX6KJv+19/l58ezMDhFuHFMatq iBAA= 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: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=ub66hQkQSnVg2B8Fk0sUL2s8H+Bjtofz0d0X7SGabqotN04sxsuuk63HuvIDLp zPjo5Wiys0QGKs0OT/kVDc9B2Elxj9eB9I/c8bou23b2u2CJSY4LYRVBKGuqSRkB 8/R6EF4yFjcklSV5im6pbTFrd5O7oFZKBoZG91Aa9IhuY=; Received: (qmail 30709 invoked by alias); 12 Feb 2012 18:55:26 -0000 Received: (qmail 30692 invoked by uid 22791); 12 Feb 2012 18:55:25 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp25.services.sfr.fr (HELO smtp25.services.sfr.fr) (93.17.128.118) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 12 Feb 2012 18:55:10 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2504.sfr.fr (SMTP Server) with ESMTP id A6AE370000F2; Sun, 12 Feb 2012 19:55:08 +0100 (CET) Received: from gimli.local (105.123.193.77.rev.sfr.net [77.193.123.105]) by msfrf2504.sfr.fr (SMTP Server) with ESMTP id 34BF4700006B; Sun, 12 Feb 2012 19:55:08 +0100 (CET) X-SFR-UUID: 20120212185508216.34BF4700006B@msfrf2504.sfr.fr Message-ID: <4F380B06.5050304@sfr.fr> Date: Sun, 12 Feb 2012 19:55:02 +0100 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; FreeBSD amd64; rv:9.0) Gecko/20120112 Thunderbird/9.0 MIME-Version: 1.0 To: gfortran , gcc-patches Subject: [Patch, fortran] PR50981 correctly handle absent arrays as actual argument to elemental procedures 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, there was no specific handling for absent arrays passed as argument to elemental procedures. So, because of scalarisation, we were passing an array element reference of a NULL pointer which was failing. These patches add a conditional to pass NULL when the data pointer is NULL. Normally, it would be best to have the conditional moved out of the loop. However, for fear of combinatorial explosion and to avoid extra complexity when there is more than one optional argument, I have left the conditional in the loop, and hope that the middle-end will do the right thing. The first patch moves the recently added `can_be_null_ref' field out of the scalar-only part of the data union in the gfc_ss_info struct, and also moves the code setting it out of the scalar-only block in gfc_walk_elemental_function_args. The second patch adds the conditional in gfc_conv_procedure_call. We need to make sure to save the value of se->ss, as gfc_conv_tmp_array_ref or gfc_conv_expr_reference will advance it to the next in the chain. Otherwise nothing special. Regression tested on x86_64-unknown-freebsd9.0. OK for trunk? Mikael 2012-02-12 Mikael Morin * trans.h (struct gfc_ss_info): Move can_be_null_ref component from the data::scalar subcomponent to the toplevel. * trans-expr.c (gfc_conv_expr): Update component reference. * trans-array.c (gfc_add_loop_ss_code): Ditto. (gfc_walk_elemental_function_args): Ditto. Move the conditional setting the field out of the scalar-only block. 2012-02-12 Mikael Morin * trans-expr.c (gfc_conv_procedure_call): Save se->ss's value. Handle the case of unallocated arrays passed to elemental procedures. 2012-02-12 Mikael Morin * gfortran.dg/elemental_optional_args_5.f03: Add array checks. Index: elemental_optional_args_5.f03 =================================================================== --- elemental_optional_args_5.f03 (révision 184142) +++ elemental_optional_args_5.f03 (copie de travail) @@ -69,7 +69,52 @@ if (s /= 5*2) call abort() if (any (v /= [5*2, 5*2])) call abort() +! ARRAY COMPONENTS: Non alloc/assoc +v = [9, 33] + +call sub1 (v, x%a2, .false.) +!print *, v +if (any (v /= [9, 33])) call abort() + +call sub1 (v, x%p2, .false.) +!print *, v +if (any (v /= [9, 33])) call abort() + + +! ARRAY COMPONENTS: alloc/assoc + +allocate (x%a2(2), x%p2(2)) +x%a2(:) = [84, 82] +x%p2 = [35, 58] + +call sub1 (v, x%a2, .true.) +!print *, v +if (any (v /= [84*2, 82*2])) call abort() + +call sub1 (v, x%p2, .true.) +!print *, v +if (any (v /= [35*2, 58*2])) call abort() + + +! =============== sub_t ================== +! SCALAR DT: Non alloc/assoc + +s = 3 +v = [9, 33] + +call sub_t (s, ta, .false.) +call sub_t (v, ta, .false.) +!print *, s, v +if (s /= 3) call abort() +if (any (v /= [9, 33])) call abort() + +call sub_t (s, tp, .false.) +call sub_t (v, tp, .false.) +!print *, s, v +if (s /= 3) call abort() +if (any (v /= [9, 33])) call abort() + contains elemental subroutine sub1 (x, y, alloc) @@ -82,5 +127,15 @@ contains x = y*2 end subroutine sub1 + elemental subroutine sub_t(x, y, alloc) + integer, intent(inout) :: x + type(t), intent(in), optional :: y + logical, intent(in) :: alloc + if (alloc .neqv. present (y)) & + x = -99 + if (present(y)) & + x = y%a*2 + end subroutine sub_t + end