From patchwork Mon Jun 14 09:28:09 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55500 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 0A2F81007D2 for ; Mon, 14 Jun 2010 19:28:11 +1000 (EST) Received: (qmail 13934 invoked by alias); 14 Jun 2010 09:28:08 -0000 Received: (qmail 13923 invoked by uid 22791); 14 Jun 2010 09:28:07 -0000 X-SWARE-Spam-Status: No, hits=-0.9 required=5.0 tests=AWL, BAYES_20, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 14 Jun 2010 09:28:00 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 0D35BCB02BD; Mon, 14 Jun 2010 11:28:03 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id lnnt1iSRqGpN; Mon, 14 Jun 2010 11:28:02 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id ECE11CB021B; Mon, 14 Jun 2010 11:28:02 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id EB4E8D9B31; Mon, 14 Jun 2010 11:28:09 +0200 (CEST) Date: Mon, 14 Jun 2010 11:28:09 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Handling of implicit dereferences in generic units. Message-ID: <20100614092809.GA30044@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i 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 The front-end materializes dereferences whenever needed, to simplify access checks. Explicit dereferences should not be inserted in generic units, because the tree for a nested generic can become inconsistent, and access checks are not generated for them in any case. The dereference will be recreated in any subsequent instance of the generic unit. The following must compile quietly: procedure deref is package Sync is type Synchronizer is access procedure (Data : in Integer); generic type Data_Type is private; package Data_Utility_Generic is procedure Synchronize (Data : in Data_Type); end Data_Utility_Generic; end Sync; package body Sync is The_Synchronizer : Synchronizer; package body Data_Utility_Generic is procedure Synchronize (Data : in Data_Type) is begin The_Synchronizer (Data => 15); end Synchronize; end Data_Utility_Generic; end Sync; generic type buffer_data is private; package complicated_generic is end complicated_generic; package body complicated_generic is package Actual_Sync is new Sync.Data_Utility_Generic (buffer_data); end complicated_generic; begin null; end deref; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Ed Schonberg * sem_ch12.adb (Save_References): If an identifier has been rewritten during analysis as an explicit dereference, keep the reference implicit in the generic, but preserve the entity if global. This prevents malformed generic trees in the presence of some nested generics. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 160705) +++ sem_ch12.adb (working copy) @@ -4848,8 +4848,13 @@ -- To detect this case we have to rescan the list of formals, which -- is usually short enough to ignore the resulting inefficiency. + ----------------------------- + -- Denotes_Previous_Actual -- + ----------------------------- + function Denotes_Previous_Actual (Typ : Entity_Id) return Boolean is Prev : Entity_Id; + begin Prev := First_Entity (Instance); while Present (Prev) loop @@ -4859,12 +4864,15 @@ and then Entity (Subtype_Indication (Parent (Prev))) = Typ then return True; + elsif Prev = E then return False; + else Next_Entity (Prev); end if; end loop; + return False; end Denotes_Previous_Actual; @@ -5874,7 +5882,7 @@ -- If we are not instantiating, then this is where we load and -- analyze subunits, i.e. at the point where the stub occurs. A - -- more permissible system might defer this analysis to the point + -- more permissive system might defer this analysis to the point -- of instantiation, but this seems to complicated for now. if not Instantiating then @@ -10480,10 +10488,18 @@ Collect_Previous_Instances (Private_Declarations (Specification (Decl))); + -- Previous non-generic bodies may contain instances as well + elsif Nkind (Decl) = N_Package_Body and then Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package then Collect_Previous_Instances (Declarations (Decl)); + + elsif Nkind (Decl) = N_Subprogram_Body + and then not Acts_As_Spec (Decl) + and then not Is_Generic_Subprogram (Corresponding_Spec (Decl)) + then + Collect_Previous_Instances (Declarations (Decl)); end if; Next (Decl); @@ -12023,18 +12039,17 @@ elsif Nkind (N2) = N_Explicit_Dereference then -- An identifier is rewritten as a dereference if it is the - -- prefix in an implicit dereference. + -- prefix in an implicit dereference (call or attribute). + -- The analysis of an instantiation will expand the node + -- again, so we preserve the original tree but link it to + -- the resolved entity in case it is global. - -- Check whether corresponding entity in prefix is global - if Is_Entity_Name (Prefix (N2)) and then Present (Entity (Prefix (N2))) and then Is_Global (Entity (Prefix (N2))) then - Rewrite (N, - Make_Explicit_Dereference (Loc, - Prefix => - New_Occurrence_Of (Entity (Prefix (N2)), Loc))); + Set_Associated_Node (N, Prefix (N2)); + elsif Nkind (Prefix (N2)) = N_Function_Call and then Is_Global (Entity (Name (Prefix (N2)))) then