From patchwork Mon Apr 2 10:52:14 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 150108 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 12845B6EEB for ; Mon, 2 Apr 2012 20:52:34 +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=1333968755; 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=dWInNEtJWB7OeE7+ADdk WZO+4R4=; b=gpmKVdTpnHCk2Ue41obs8ejvtn1X9ut1+WqgjQE850BQ3cuyJS3f kzFpd2I4f6wOafwHNPi1g0nAPa0AvhyLEpBxQ2QsMwM0b7zis2mapT/D/DaO3bC7 7AJEz61Qkv6qvQvEWqnwDiNj+OadteiH45lDEwIHlNRjBZ9BUoHJLak= 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=lNyXYuRPXDSHiZMsiQNAnwMEtfa9Gg+B90XMQMOiaqbM0fYZ84TpX0iHszLDEm 6DNIWMpH9qXzxM0bBNm6eOk9z5HGrPYXuo6klihO84Bh9HnxxCbw46+dPKZ5BkD0 ayZrHsQmXmPBALAxdEhGWQmso/VIf3rRQ8gyNrrux8NOk=; Received: (qmail 14637 invoked by alias); 2 Apr 2012 10:52:31 -0000 Received: (qmail 14629 invoked by uid 22791); 2 Apr 2012 10:52:29 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO 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; Mon, 02 Apr 2012 10:52:15 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 623081C68F4; Mon, 2 Apr 2012 06:52:14 -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 w1RhDdGH9QBA; Mon, 2 Apr 2012 06:52:14 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 42FA61C68E6; Mon, 2 Apr 2012 06:52:14 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 426233FEE8; Mon, 2 Apr 2012 06:52:14 -0400 (EDT) Date: Mon, 2 Apr 2012 06:52:14 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] New Z lines in ALI files for implicit withs from instantiation Message-ID: <20120402105214.GA25628@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 Units that are only withed from generic instantiation are now put in the ALI file as Z lines instead of W lines. There is no impact on GNAT tools. This is for the benefit of gprbuild. The test for this is to have a unit A instantiating a generic unit B, the body of which import a package C. In tha ALI file for A, there should be a Z line for package C. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-04-02 Vincent Celier * ali.adb (Scan_Ali): Recognize Z lines. Set Implicit_With_From_Instantiation to True in the With_Record for Z lines. * ali.ads (With_Record): New Boolean component Implicit_With_From_Instantiation, defaulted to False. * csinfo.adb: Indicate that Implicit_With_From_Instantiation is special * lib-writ.adb (Write_ALI): New array Implicit_With. (Collect_Withs): Set Implicit_With for the unit is it is not Yes. (Write_With_Lines): Write a Z line instead of a W line if Implicit_With is Yes for the unit. * sem_ch12.adb (Inherit_Context): Only add a unit in the context if it is not there yet. * sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12) added. Index: csinfo.adb =================================================================== --- csinfo.adb (revision 186067) +++ csinfo.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -218,6 +218,7 @@ Set (Special, "Has_Dynamic_Range_Check", True); Set (Special, "Has_Dynamic_Length_Check", True); Set (Special, "Has_Private_View", True); + Set (Special, "Implicit_With_From_Instantiation", True); Set (Special, "Is_Controlling_Actual", True); Set (Special, "Is_Overloaded", True); Set (Special, "Is_Static_Expression", True); Index: sinfo.adb =================================================================== --- sinfo.adb (revision 186067) +++ sinfo.adb (working copy) @@ -1624,6 +1624,14 @@ return Flag16 (N); end Implicit_With; + function Implicit_With_From_Instantiation + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + return Flag12 (N); + end Implicit_With_From_Instantiation; + function Interface_List (N : Node_Id) return List_Id is begin @@ -4704,6 +4712,14 @@ Set_Flag16 (N, Val); end Set_Implicit_With; + procedure Set_Implicit_With_From_Instantiation + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + Set_Flag12 (N, Val); + end Set_Implicit_With_From_Instantiation; + procedure Set_Interface_List (N : Node_Id; Val : List_Id) is begin Index: sinfo.ads =================================================================== --- sinfo.ads (revision 186076) +++ sinfo.ads (working copy) @@ -1226,6 +1226,9 @@ -- 'Address or 'Tag attribute. ???There are other implicit with clauses -- as well. + -- Implicit_With_From_Instantiation (Flag12-Sem) + -- Set in N_With_Clause nodes from generic instantiations. + -- Import_Interface_Present (Flag16-Sem) -- This flag is set in an Interface or Import pragma if a matching -- pragma of the other kind is also present. This is used to avoid @@ -5805,6 +5808,7 @@ -- Elaborate_Desirable (Flag11-Sem) -- Private_Present (Flag15) set if with_clause has private keyword -- Implicit_With (Flag16-Sem) + -- Implicit_With_From_Instantiation (Flag12-Sem) -- Limited_Present (Flag17) set if LIMITED is present -- Limited_View_Installed (Flag18-Sem) -- Unreferenced_In_Spec (Flag7-Sem) @@ -8592,6 +8596,9 @@ function Implicit_With (N : Node_Id) return Boolean; -- Flag16 + function Implicit_With_From_Instantiation + (N : Node_Id) return Boolean; -- Flag12 + function Import_Interface_Present (N : Node_Id) return Boolean; -- Flag16 @@ -9573,6 +9580,9 @@ procedure Set_Implicit_With (N : Node_Id; Val : Boolean := True); -- Flag16 + procedure Set_Implicit_With_From_Instantiation + (N : Node_Id; Val : Boolean := True); -- Flag12 + procedure Set_Import_Interface_Present (N : Node_Id; Val : Boolean := True); -- Flag16 @@ -11959,6 +11969,7 @@ pragma Inline (High_Bound); pragma Inline (Identifier); pragma Inline (Implicit_With); + pragma Inline (Implicit_With_From_Instantiation); pragma Inline (Interface_List); pragma Inline (Interface_Present); pragma Inline (Includes_Infinities); Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 186067) +++ lib-writ.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -196,6 +196,10 @@ Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean; -- Array of flags to show which units have Elaborate_All_Desirable set + type Yes_No is (Unknown, Yes, No); + + Implicit_With : array (Units.First .. Last_Unit) of Yes_No; + Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2)); -- Sorted table of source dependencies. One extra entry in case we -- have to add a dummy entry for System. @@ -276,6 +280,15 @@ else Set_From_With_Type (Cunit_Entity (Unum)); end if; + + if Implicit_With (Unum) /= Yes then + if Implicit_With_From_Instantiation (Item) then + Implicit_With (Unum) := Yes; + + else + Implicit_With (Unum) := No; + end if; + end if; end if; Next (Item); @@ -552,6 +565,7 @@ Elab_All_Flags (J) := False; Elab_Des_Flags (J) := False; Elab_All_Des_Flags (J) := False; + Implicit_With (J) := Unknown; end loop; Collect_Withs (Unode); @@ -770,10 +784,14 @@ Uname := Units.Table (Unum).Unit_Name; Fname := Units.Table (Unum).Unit_File_Name; - if Ekind (Cunit_Entity (Unum)) = E_Package + if Implicit_With (Unum) = Yes then + Write_Info_Initiate ('Z'); + + elsif Ekind (Cunit_Entity (Unum)) = E_Package and then From_With_Type (Cunit_Entity (Unum)) then Write_Info_Initiate ('Y'); + else Write_Info_Initiate ('W'); end if; Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 186070) +++ sem_ch12.adb (working copy) @@ -7761,6 +7761,9 @@ Item : Node_Id; New_I : Node_Id; + Clause : Node_Id; + OK : Boolean; + begin if Nkind (Parent (Gen_Decl)) = N_Compilation_Unit then @@ -7782,17 +7785,30 @@ while Present (Item) loop if Nkind (Item) = N_With_Clause then - -- Take care to prevent direct cyclic with's, which can happen - -- if the generic body with's the current unit. Such a case - -- would result in binder errors (or run-time errors if the - -- -gnatE switch is in effect), but we want to prevent it here, - -- because Sem.Walk_Library_Items doesn't like cycles. Note - -- that we don't bother to detect indirect cycles. + -- Take care to prevent direct cyclic with's. if Library_Unit (Item) /= Current_Unit then - New_I := New_Copy (Item); - Set_Implicit_With (New_I, True); - Append (New_I, Current_Context); + -- Do not add a unit if it is already in the context + + Clause := First (Current_Context); + OK := True; + while Present (Clause) loop + if Nkind (Clause) = N_With_Clause and then + Chars (Name (Clause)) = Chars (Name (Item)) + then + OK := False; + exit; + end if; + + Next (Clause); + end loop; + + if OK then + New_I := New_Copy (Item); + Set_Implicit_With (New_I, True); + Set_Implicit_With_From_Instantiation (New_I, True); + Append (New_I, Current_Context); + end if; end if; end if; Index: ali.adb =================================================================== --- ali.adb (revision 186067) +++ ali.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -55,6 +55,7 @@ 'X' => True, -- xref 'S' => True, -- specific dispatching 'Y' => True, -- limited_with + 'Z' => True, -- implicit with from instantiation 'C' => True, -- SCO information 'F' => True, -- Alfa information others => False); @@ -782,7 +783,8 @@ -- Acquire lines to be ignored if Read_Xref then - Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True); + Ignore := + ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True); -- Read_Lines parameter given @@ -1717,7 +1719,7 @@ With_Loop : loop Check_Unknown_Line; - exit With_Loop when C /= 'W' and then C /= 'Y'; + exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z'; if Ignore ('W') then Skip_Line; @@ -1733,6 +1735,8 @@ Withs.Table (Withs.Last).Elab_All_Desirable := False; Withs.Table (Withs.Last).SAL_Interface := False; Withs.Table (Withs.Last).Limited_With := (C = 'Y'); + Withs.Table (Withs.Last).Implicit_With_From_Instantiation + := (C = 'Z'); -- Generic case with no object file available Index: ali.ads =================================================================== --- ali.ads (revision 186067) +++ ali.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -558,6 +558,9 @@ Limited_With : Boolean := False; -- True if unit is named in a limited_with_clause + + Implicit_With_From_Instantiation : Boolean := False; + -- True if this is an implicit with from a generic instantiation end record; package Withs is new Table.Table (