From patchwork Sat Oct 23 12:48:08 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 68999 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 55678B70A5 for ; Sat, 23 Oct 2010 23:48:23 +1100 (EST) Received: (qmail 9425 invoked by alias); 23 Oct 2010 12:48:18 -0000 Received: (qmail 9406 invoked by uid 22791); 23 Oct 2010 12:48:17 -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 mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 23 Oct 2010 12:48:11 +0000 Received: from [192.168.178.22] (port-92-204-92-55.dynamic.qsc.de [92.204.92.55]) by mx01.qsc.de (Postfix) with ESMTP id 460783D693; Sat, 23 Oct 2010 14:48:08 +0200 (CEST) Message-ID: <4CC2D988.7010303@net-b.de> Date: Sat, 23 Oct 2010 14:48:08 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.11) Gecko/20101013 SUSE/3.1.5 Thunderbird/3.1.5 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch,Fortran] PR46122 Make PROTECT check less strict 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 Currently, GCC rejects protected_pointer%pointer%var = 5 as the "protected_pointer" is protected. However, that only protects the pointer association status - but the example does not modify it - only the target of the pointer is modified, which is valid. The solution is to do the same as with INTENT: Don't continue checking as soon as there is component-ref with a pointer component involved (which is not the last component-ref). Build and currently regtesting on x86-64-linux. OK for the trunk? Tobias 2010-10-23 Tobias Burnus PR fortran/46122 * expr.c (gfc_check_vardef_context): Fix PROTECTED check. 2010-10-23 Tobias Burnus PR fortran/46122 * gfortran.dg/protected_8.f90: New. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index ef516a4..e567c98 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4400,7 +4400,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) } /* PROTECTED and use-associated. */ - if (sym->attr.is_protected && sym->attr.use_assoc) + if (sym->attr.is_protected && sym->attr.use_assoc && check_intentin) { if (pointer && is_pointer) { diff --git a/gcc/testsuite/gfortran.dg/protected_8.f90 b/gcc/testsuite/gfortran.dg/protected_8.f90 new file mode 100644 index 0000000..aaa34a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/protected_8.f90 @@ -0,0 +1,50 @@ +! { dg-do compile } +! +! PR fortran/46122 +! +! PROTECT check +! +! Contributed by Jared Ahern +! + +MODULE amod + IMPLICIT NONE + TYPE foo + INTEGER :: i = 4 + INTEGER, POINTER :: j => NULL() + END TYPE foo + TYPE(foo), SAVE, PROTECTED :: a + TYPE(foo), SAVE, PROTECTED, POINTER :: b + INTEGER, SAVE, PROTECTED :: i = 5 + INTEGER, SAVE, PROTECTED, POINTER :: j => NULL() +contains + subroutine alloc() + allocate(b,j) + end subroutine alloc +END MODULE amod + +PROGRAM test + USE amod + IMPLICIT NONE + INTEGER, TARGET :: k + TYPE(foo), TARGET :: c + k = 2 ! local + c%i = 9 ! local + + call alloc() + + i = k ! { dg-error "is PROTECTED" } + j => k ! { dg-error "is PROTECTED" } + j = 3 ! OK 1 + a = c ! { dg-error "is PROTECTED" } + a%i = k ! { dg-error "is PROTECTED" } + a%j => k ! { dg-error "is PROTECTED" } + a%j = 5 ! OK 2 + b => c ! { dg-error "is PROTECTED" } + b%i = k ! OK 3 + b%j => k ! OK 4 + b%j = 5 ! OK 5 + +END PROGRAM test + +! { dg-final { cleanup-modules "amod" } }