From patchwork Thu Apr 12 08:57:48 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 152001 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 22B89B7095 for ; Thu, 12 Apr 2012 18:58:26 +1000 (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=1334825907; h=Comment: DomainKey-Signature: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=D30+7X4 AOtAhKD994FN4zHbTCHg=; b=MtTN0kFtjp99ZNkLBGnhF0rkt4lUG+D2X7u8xxK fNt++OjYPbrrOqiXFuWNMAg5EW1WL9TYV+OZN3G2wmibmAZwTeeYpF5W2VAHxx5e LB9GgkPIBuVIMOeijIteSmKMKWy513Qe8T2cskZoJBByydW34SLd3RPB3ha9kYGX aA94= 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: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; b=Qrg9IKni6cVWzb1msQ/RYC3BEr9hA15HnZPboSF62VX4B6gbguWb2IJT4FadmJ dBt8P5jKowicD4MKwNa40UkZGcWqNpvmygEZ45FI71ejv5l1r/57ci7ThkGsHt38 dOsh6kcgUonoP5GYhcaiqiIoQxILwmGA78t0jS8yNgt30=; Received: (qmail 12582 invoked by alias); 12 Apr 2012 08:58:22 -0000 Received: (qmail 12567 invoked by uid 22791); 12 Apr 2012 08:58:21 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 12 Apr 2012 08:57:58 +0000 Received: from [192.168.178.22] (port-92-204-5-234.dynamic.qsc.de [92.204.5.234]) by mx02.qsc.de (Postfix) with ESMTP id 73C951E7B6; Thu, 12 Apr 2012 10:57:50 +0200 (CEST) Message-ID: <4F86990C.6040804@net-b.de> Date: Thu, 12 Apr 2012 10:57:48 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:11.0) Gecko/20120328 Thunderbird/11.0.1 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR52864 - Fix pointer-intent regresssion 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 That's a GCC 4.6-4.8 regression. Pointer intents apply to the association status and not to the value. Thus, assigning to an intent(in) pointer is fine. The problem was that the LHS is no pointer due to the array access ("dt%ptr(1) =") thus, the check got triggered. Build and regtested on x86-64-linux. OK for the trunk and the 4.6/4.7 branch? Tobias 20012-04-12 Tobias Burnus PR fortran/52864 * expr.c (gfc_check_vardef_context): Fix assignment check for pointer components. 20012-04-12 Tobias Burnus PR fortran/52864 * gfortran.dg/pointer_intent_6.f90: New. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index e6a9c88..7ce693b 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4656,7 +4680,11 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (ptr_component && ref->type == REF_COMPONENT) check_intentin = false; if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) - ptr_component = true; + { + ptr_component = true; + if (!pointer) + check_intentin = false; + } } if (check_intentin && sym->attr.intent == INTENT_IN) { --- /dev/null 2012-04-12 06:55:49.927755790 +0200 +++ gcc/gcc/testsuite/gfortran.dg/pointer_intent_6.f90 2012-04-12 09:35:25.000000000 +0200 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR fortran/52864 +! +! Assigning to an intent(in) pointer (which is valid). +! + program test + type PoisFFT_Solver3D + complex, dimension(:,:,:), & + pointer :: work => null() + end type PoisFFT_Solver3D + contains + subroutine PoisFFT_Solver3D_FullPeriodic(D, p) + type(PoisFFT_Solver3D), intent(in) :: D + real, intent(in), pointer :: p(:) + D%work(i,j,k) = 0.0 + p = 0.0 + end subroutine + end