From patchwork Thu Oct 4 09:08:36 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 189068 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 692582C0355 for ; Thu, 4 Oct 2012 19:08:54 +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=1349946534; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=qGB01cZoqY+2s1e77f6K 4DZbpIU=; b=XoCHQ1wcjxLbkq8HxoDDcgsnYNXuN9IOYXYDexTJ/4VZCDHmm706 6HmiZGrKBsMSYIEFg7zpTNkUBGtSAM9rI1hK06wbM54+EiBrjqT/sFZ2fOkHpfTi 9kaxFYqzIt5Hvx70Wd7/71FGOSvETVlhdCRSFLaEyjFUsQqj+78utZE= 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:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=LgstnUf1FZYM/B+r1QDj/9xefWYr5R9u5CjzeTXjXoZzmKRZLjlKcmjxk9Xjeo o9AY7hkmSdO3ypuOUVtS5NQQqV6m9Asj7FdMg0K9s05joBk9FhOVw98CHTN559EO DjQIxgB2OtCfbNFzLdJ2QMg9YDgfy8Alt6DGR2h1XwHyI=; Received: (qmail 16524 invoked by alias); 4 Oct 2012 09:08:44 -0000 Received: (qmail 16506 invoked by uid 22791); 4 Oct 2012 09:08:41 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO, T_FILL_THIS_FORM_SHORT X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 04 Oct 2012 09:08:37 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0289C1C7E62; Thu, 4 Oct 2012 05:08:37 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id j3qX6TxcfBQw; Thu, 4 Oct 2012 05:08:36 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id D8DCB1C7E60; Thu, 4 Oct 2012 05:08:36 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id D4541919E3; Thu, 4 Oct 2012 05:08:36 -0400 (EDT) Date: Thu, 4 Oct 2012 05:08:36 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] Visibility error in the presence of private limited with clauses Message-ID: <20121004090836.GA30303@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 This patch fixes a visibility error when compiling a unit DDP, when an ancestor P of DDP has a private limited with clause on a descendant of P that is itself an ancestor of DDP. The following must compile quietly: gcc -c -gnat05 bg-el-lc.adb --- package body BG.El.LC is overriding procedure Bind (E : access One_Port; K : in AKind) is begin null; end Bind; end BG.El.LC; --- package BG.El.LC is type Component is abstract new Element with null record; private type One_Port is new Component with null record; overriding procedure Bind (E : access One_Port; K : in AKind); end BG.El.LC; --- with Ada.Strings.Bounded; private package BG.El is type Element is abstract tagged private; type AKind is (A, B); procedure Bind (E : access Element; K : in AKind) is abstract; private type Element is abstract tagged null record; end BG.El; --- limited private with BG.El; package BG is type Object is abstract tagged limited private; procedure Bind (Graph : in out Object) is abstract; private type Object is abstract tagged limited null record; end BG; Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-04 Ed Schonberg * sem_ch10.adb (Is_Ancestor_Unit): Make global, for use elsewhere. (Install_Private_with_Clauses): if clause is private and limited, do not install the limited view if the library unit is an ancestor of the unit being compiled. This unusual configuration occurs when compiling a unit DDP, when an ancestor P of DDP has a private limited with clause on a descendant of P that is itself an ancestor of DDP. Index: sem_ch10.adb =================================================================== --- sem_ch10.adb (revision 192066) +++ sem_ch10.adb (working copy) @@ -164,6 +164,11 @@ -- an enclosing scope. Iterate over context to find child units of U_Name -- or of some ancestor of it. + function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean; + -- When compiling a unit Q descended from some parent unit P, a limited + -- with_clause in the context of P that names some other ancestor of Q + -- must not be installed because the ancestor is immediately visible. + function Is_Child_Spec (Lib_Unit : Node_Id) return Boolean; -- Lib_Unit is a library unit which may be a spec or a body. Is_Child_Spec -- returns True if Lib_Unit is a library spec which is a child spec, i.e. @@ -3521,11 +3526,6 @@ -- units. The shadow entities are created when the inserted clause is -- analyzed. Implements Ada 2005 (AI-50217). - function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean; - -- When compiling a unit Q descended from some parent unit P, a limited - -- with_clause in the context of P that names some other ancestor of Q - -- must not be installed because the ancestor is immediately visible. - --------------------- -- Check_Renamings -- --------------------- @@ -3794,22 +3794,6 @@ end if; end Expand_Limited_With_Clause; - ---------------------- - -- Is_Ancestor_Unit -- - ---------------------- - - function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is - E1 : constant Entity_Id := Defining_Entity (Unit (U1)); - E2 : Entity_Id; - begin - if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then - E2 := Defining_Entity (Unit (Library_Unit (U2))); - return Is_Ancestor_Package (E1, E2); - else - return False; - end if; - end Is_Ancestor_Unit; - -- Start of processing for Install_Limited_Context_Clauses begin @@ -4061,8 +4045,17 @@ if Nkind (Item) = N_With_Clause and then Private_Present (Item) then + -- If the unit is an ancestor of the current one, it is the + -- case of a private limited with clause on a child unit, and + -- the compilation of one of its descendants, In that case the + -- limited view is errelevant. + if Limited_Present (Item) then - if not Limited_View_Installed (Item) then + if not Limited_View_Installed (Item) + and then + not Is_Ancestor_Unit (Library_Unit (Item), + Cunit (Current_Sem_Unit)) + then Install_Limited_Withed_Unit (Item); end if; else @@ -5269,6 +5262,22 @@ (C_Unit, Cunit_Entity (Get_Source_Unit (Non_Limited_View (T)))); end Is_Legal_Shadow_Entity_In_Body; + ---------------------- + -- Is_Ancestor_Unit -- + ---------------------- + + function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is + E1 : constant Entity_Id := Defining_Entity (Unit (U1)); + E2 : Entity_Id; + begin + if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then + E2 := Defining_Entity (Unit (Library_Unit (U2))); + return Is_Ancestor_Package (E1, E2); + else + return False; + end if; + end Is_Ancestor_Unit; + ----------------------- -- Load_Needed_Body -- -----------------------