From patchwork Thu Jan 11 09:05:36 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 858942 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-470788-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="DLlbD6gZ"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zHKjp0JPQz9t3F for ; Thu, 11 Jan 2018 20:06:05 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=s4PMq1IFp950YmOX74t9l66U5J+Pqa+soiCTn31qwRNJewjC7P 6Fv3wJC+Q2IL9QcwfT3SMzUAoOnXriyr8c4Ky1Ui5ZHJN2rH94qFWHGvwxEURJHC soyA+cest9eQmcEuagguNDqDjyBQqjkA+pgDXReyHDycb/a11u+PS/GQI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=iXVkQloLxrT5Ytx5oWQEkZx4KBE=; b=DLlbD6gZsiY1x6hQ0YvI Vj8MtFl7cc964DOoplzS6rgjv4W1qm51G2MZKI0rFXoAb7zi07iK9r19/7x9KroU vWB+rv40nIz0b6EFumGQk8Rhm3p7CGuu2ndcKr3QeVkBIYgI4fEk+XNRpc48mayV SDxeQkAi22JDVXNA9h0L/e0= Received: (qmail 20844 invoked by alias); 11 Jan 2018 09:05:44 -0000 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 Received: (qmail 20745 invoked by uid 89); 11 Jan 2018 09:05:44 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, WEIRD_QUOTING autolearn=ham version=3.3.2 spammy=ABC, Soft, sk:limited, impose X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 11 Jan 2018 09:05:37 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 47553117BC0; Thu, 11 Jan 2018 04:05:36 -0500 (EST) 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 9s7TLjYZWDru; Thu, 11 Jan 2018 04:05:36 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 3350D117BBE; Thu, 11 Jan 2018 04:05:36 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 31EB450B; Thu, 11 Jan 2018 04:05:36 -0500 (EST) Date: Thu, 11 Jan 2018 04:05:36 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Encoding of with clauses in ALI files Message-ID: <20180111090536.GA103079@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch modifies the encodings of with clauses in ALI files to adhere to the existing API. The encodigs are as follows: * Explicit with clauses are encoded on a 'W' line (same as before). * Implicit with clauses for ancestor units are encoded on a 'W' line (same as before). * Limited_with clauses are encoded on a 'Y' line (same as before). * ABE and RTSfind-related with clauses are encoded on a 'Z' line. ------------ -- Source -- ------------ -- case_10_func.adb function Case_10_Func return Boolean is begin return True; end Case_10_Func; -- case_10_gen_func.ads generic function Case_10_Gen_Func return Boolean; -- case_10_gen_func.adb function Case_10_Gen_Func return Boolean is begin return True; end Case_10_Gen_Func; -- case_10_tasks.ads package Case_10_Tasks is task type Task_Typ is end Task_Typ; end Case_10_Tasks; -- case_10_tasks.adb package body Case_10_Tasks is task body Task_Typ is begin null; end Task_Typ; end Case_10_Tasks; -- case_10_gen.ads with Case_10_Func; with Case_10_Gen_Func; with Case_10_Tasks; generic package Case_10_Gen is Val : constant Boolean := Case_10_Func; function Inst is new Case_10_Gen_Func; Tsk : Case_10_Tasks.Task_Typ; end Case_10_Gen; -- case_10.ads with Case_10_Gen; package Case_10 is package Inst is new Case_10_Gen; end Case_10; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c case_10.ads $ grep "W " case_10.ali | sort $ grep "Z " case_10.ali | sort W case_10_gen%s case_10_gen.ads case_10_gen.ali Z case_10_func%b case_10_func.adb case_10_func.ali Z case_10_gen_func%s case_10_gen_func.adb case_10_gen_func.ali ED Z case_10_tasks%s case_10_tasks.adb case_10_tasks.ali AD Z system.soft_links%s s-soflin.adb s-soflin.ali Z system.tasking%s s-taskin.adb s-taskin.ali Z system.tasking.stages%s s-tassta.adb s-tassta.ali Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Hristian Kirtchev gcc/ada/ * ali.adb: Document the remaining letters available for ALI lines. (Scan_ALI): A with clause is internal when it is encoded on a 'Z' line. * ali.ads: Update type With_Record. Field Implicit_With_From_Instantiation is no longer in use. Add field Implicit_With. * csinfo.adb (CSinfo): Remove the setup for attribute Implicit_With_From_Instantiation. * lib-writ.adb (Collect_Withs): Correct the logic which marks a unit as either implicitly or explicitly withed. (Is_Implicit_With_Clause): New routine. (Write_ALI): Rename array Implicit_With to Has_Implicit_With to avoid confusion with the with clause attribute by the same name. (Write_With_Lines): Update the emission of 'W', 'Y', and 'Z' headers. * rtsfind.adb (Maybe_Add_With): Code cleanup. * sem_ch8.adb (Present_System_Aux): Code cleanup. * sem_ch10.adb (Expand_With_Clause): Mark the with clause as generated for a parent unit. (Implicit_With_On_Parent): Mark the with clause as generated for a parent unit. * sem_ch12.adb (Inherit_Context): With clauses inherited by an instantiation are no longer marked as Implicit_With_From_Instantiation because they are already marked as implicit. * sem_elab.adb (Ensure_Prior_Elaboration_Static): Remove the kludge which marks implicit with clauses as related to an instantiation. * sinfo.adb (Implicit_With_From_Instantiation): Removed. (Parent_With): New routine. (Set_Implicit_With_From_Instantiation): Removed. (Set_Parent_With): New routine. * sinfo.ads: Update the documentation of attribute Implicit_With. Remove attribute Implicit_With_From_Instantiation along with occurrences in nodes. Add attribute Parent_With along with occurrences in nodes. (Implicit_With_From_Instantiation): Removed along with pragma Inline. (Parent_With): New routine along with pragma Inline. (Set_Implicit_With_From_Instantiation): Removed along with pragma Inline. (Set_Parent_With): New routine along with pragma Inline. --- gcc/ada/ali.adb +++ gcc/ada/ali.adb @@ -35,9 +35,11 @@ package body ALI is use ASCII; -- Make control characters visible - -- The following variable records which characters currently are - -- used as line type markers in the ALI file. This is used in - -- Scan_ALI to detect (or skip) invalid lines. + -- The following variable records which characters currently are used as + -- line type markers in the ALI file. This is used in Scan_ALI to detect + -- (or skip) invalid lines. The following letters are still available: + -- + -- B G H J K O Q Z Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean := ('V' => True, -- version @@ -2028,8 +2030,7 @@ package body ALI is 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'); + Withs.Table (Withs.Last).Implicit_With := (C = 'Z'); -- Generic case with no object file available --- gcc/ada/ali.ads +++ gcc/ada/ali.ads @@ -82,7 +82,6 @@ package ALI is -- Indicator of whether unit can be used as main program type ALIs_Record is record - Afile : File_Name_Type; -- Name of ALI file @@ -226,7 +225,6 @@ package ALI is -- Last_Specific_Dispatching = First_Specific_Dispatching - 1. That -- is why the 'Base reference is there, it can be one less than the -- lower bound of the subtype. Not set if 'S' appears in Ignore_Lines. - end record; No_Main_Priority : constant Int := -1; @@ -265,7 +263,6 @@ package ALI is -- Version string, taken from unit record type Unit_Record is record - My_ALI : ALI_Id; -- Corresponding ALI entry @@ -568,7 +565,6 @@ package ALI is -- Id of first actual entry in table type With_Record is record - Uname : Unit_Name_Type; -- Name of Unit @@ -587,17 +583,17 @@ package ALI is Elab_All_Desirable : Boolean; -- Indicates presence of AD parameter - Elab_Desirable : Boolean; + Elab_Desirable : Boolean; -- Indicates presence of ED parameter SAL_Interface : Boolean := False; -- True if the Unit is an Interface of a Stand-Alone Library - Limited_With : Boolean := False; - -- True if unit is named in a limited_with_clause + Implicit_With : Boolean := False; + -- True if this is an implicit with generated by the compiler - Implicit_With_From_Instantiation : Boolean := False; - -- True if this is an implicit with from a generic instantiation + Limited_With : Boolean := False; + -- True if this is a limited_with_clause end record; package Withs is new Table.Table ( @@ -778,7 +774,6 @@ package ALI is -- successive ALI files are scanned. type Sdep_Record is record - Sfile : File_Name_Type; -- Name of source file --- gcc/ada/csinfo.adb +++ gcc/ada/csinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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,7 +218,6 @@ begin 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);--- gcc/ada/lib-writ.adb +++ gcc/ada/lib-writ.adb @@ -215,9 +215,9 @@ package body Lib.Writ is -- 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; + Has_Implicit_With : array (Units.First .. Last_Unit) of Yes_No; -- Indicates if an implicit with has been given for the unit. Yes if - -- certainly present, no if certainly absent, unkonwn if not known. + -- certainly present, No if certainly absent, Unknown if not known. Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2)); -- Sorted table of source dependencies. One extra entry in case we @@ -235,8 +235,8 @@ package body Lib.Writ is ----------------------- procedure Collect_Withs (Cunit : Node_Id); - -- Collect with lines for entries in the context clause of the - -- given compilation unit, Cunit. + -- Collect with lines for entries in the context clause of the given + -- compilation unit, Cunit. procedure Update_Tables_From_ALI_File; -- Given an up to date ALI file (see Up_To_Date_ALI_file_Exists @@ -261,9 +261,47 @@ package body Lib.Writ is ------------------- procedure Collect_Withs (Cunit : Node_Id) is + function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean; + pragma Inline (Is_Implicit_With_Clause); + -- Determine whether a with clause denoted by Clause is implicit + + ----------------------------- + -- Is_Implicit_With_Clause -- + ----------------------------- + + function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is + begin + -- With clauses created for ancestor units are marked as internal, + -- however, they emulate the semantics in Ada RM 10.1.2 (6/2), + -- where + -- + -- with A.B; + -- + -- is almost equivalent to + -- + -- with A; + -- with A.B; + -- + -- For ALI encoding purposes, they are considered to be explicit. + -- Note that the clauses cannot be marked as explicit because they + -- will be subjected to various checks related to with clauses and + -- possibly cause false positives. + + if Parent_With (Clause) then + return False; + + else + return Implicit_With (Clause); + end if; + end Is_Implicit_With_Clause; + + -- Local variables + Item : Node_Id; Unum : Unit_Number_Type; + -- Start of processing for Collect_Withs + begin Item := First (Context_Items (Cunit)); while Present (Item) loop @@ -300,12 +338,28 @@ package body Lib.Writ is Set_From_Limited_With (Cunit_Entity (Unum)); end if; - if Implicit_With (Unum) /= Yes then - if Implicit_With_From_Instantiation (Item) then - Implicit_With (Unum) := Yes; + if Is_Implicit_With_Clause (Item) then + + -- A previous explicit with clause withs the unit. Retain + -- this classification, as it reflects the source relations + -- between units. + + if Has_Implicit_With (Unum) = No then + null; + + -- Otherwise this is either the first time any clause withs + -- the unit, or the unit is already implicitly withed. + else - Implicit_With (Unum) := No; + Has_Implicit_With (Unum) := Yes; end if; + + -- Otherwise the current with clause is explicit. Such clauses + -- take precedence over existing implicit clauses because they + -- reflect the source relations between unit. + + else + Has_Implicit_With (Unum) := No; end if; end if; @@ -573,7 +627,7 @@ package body Lib.Writ is Elab_All_Flags (J) := False; Elab_Des_Flags (J) := False; Elab_All_Des_Flags (J) := False; - Implicit_With (J) := Unknown; + Has_Implicit_With (J) := Unknown; end loop; Collect_Withs (Unode); @@ -853,14 +907,17 @@ package body Lib.Writ is Uname := Units.Table (Unum).Unit_Name; Fname := Units.Table (Unum).Unit_File_Name; - if Implicit_With (Unum) = Yes then - Write_Info_Initiate ('Z'); + -- Limited with clauses must be processed first because they are + -- the most specific among the three kinds. - elsif Ekind (Cunit_Entity (Unum)) = E_Package + if Ekind (Cunit_Entity (Unum)) = E_Package and then From_Limited_With (Cunit_Entity (Unum)) then Write_Info_Initiate ('Y'); + elsif Has_Implicit_With (Unum) = Yes then + Write_Info_Initiate ('Z'); + else Write_Info_Initiate ('W'); end if;--- gcc/ada/rtsfind.adb +++ gcc/ada/rtsfind.adb @@ -1124,15 +1124,15 @@ package body Rtsfind is end loop; Withn := - Make_With_Clause (Standard_Location, - Name => - Make_Unit_Name - (U, Defining_Unit_Name (Specification (LibUnit)))); + Make_With_Clause (Standard_Location, + Name => + Make_Unit_Name + (U, Defining_Unit_Name (Specification (LibUnit)))); - Set_Library_Unit (Withn, Cunit (U.Unum)); Set_Corresponding_Spec (Withn, U.Entity); - Set_First_Name (Withn, True); - Set_Implicit_With (Withn, True); + Set_First_Name (Withn); + Set_Implicit_With (Withn); + Set_Library_Unit (Withn, Cunit (U.Unum)); Set_Next_Implicit_With (Withn, U.First_Implicit_With); U.First_Implicit_With := Withn;--- gcc/ada/sem_ch10.adb +++ gcc/ada/sem_ch10.adb @@ -472,8 +472,8 @@ package body Sem_Ch10 is -- visibility analysis, but is also not redundant. elsif Nkind (Cont_Item) = N_With_Clause - and then not Implicit_With (Cont_Item) and then Comes_From_Source (Cont_Item) + and then not Implicit_With (Cont_Item) and then not Limited_Present (Cont_Item) and then Cont_Item /= Clause and then Entity (Name (Cont_Item)) = Nam_Ent @@ -517,16 +517,16 @@ package body Sem_Ch10 is begin Process_Spec_Clauses - (Context_List => Spec_Context_Items, - Clause => Clause, - Used => Used_In_Spec, - Withed => Withed_In_Spec); + (Context_List => Spec_Context_Items, + Clause => Clause, + Used => Used_In_Spec, + Withed => Withed_In_Spec); Process_Body_Clauses - (Context_List => Context_Items, - Clause => Clause, - Used => Used_In_Body, - Used_Type_Or_Elab => Used_Type_Or_Elab); + (Context_List => Context_Items, + Clause => Clause, + Used => Used_In_Body, + Used_Type_Or_Elab => Used_Type_Or_Elab); -- "Type Elab" refers to the presence of either a use -- type clause, pragmas Elaborate or Elaborate_All. @@ -555,29 +555,29 @@ package body Sem_Ch10 is ("redundant with clause in body?r?", Clause); end if; - Used_In_Body := False; - Used_In_Spec := False; + Used_In_Body := False; + Used_In_Spec := False; Used_Type_Or_Elab := False; - Withed_In_Spec := False; + Withed_In_Spec := False; end; -- Standalone package spec or body check else declare - Dont_Care : Boolean := False; - Withed : Boolean := False; + Dummy : Boolean := False; + Withed : Boolean := False; begin -- The mechanism for examining the context clauses of a -- package spec can be applied to package body clauses. Process_Spec_Clauses - (Context_List => Context_Items, - Clause => Clause, - Used => Dont_Care, - Withed => Withed, - Exit_On_Self => True); + (Context_List => Context_Items, + Clause => Clause, + Used => Dummy, + Withed => Withed, + Exit_On_Self => True); if Withed then Error_Msg_N -- CODEFIX @@ -1058,7 +1058,7 @@ package body Sem_Ch10 is if Nkind (Item) = N_With_Clause and then not Implicit_With (Item) - -- Ada 2005 (AI-50217): Ignore limited-withed units + -- Ada 2005 (AI-50217): Ignore limited-withed units and then not Limited_Present (Item) then @@ -1487,8 +1487,9 @@ package body Sem_Ch10 is P := Parent_Spec (Unit (N)); loop if Unit (P) = Lib_U then - Error_Msg_N ("limited with_clause cannot " - & "name ancestor", Item); + Error_Msg_N + ("limited with_clause cannot name ancestor", + Item); exit; end if; @@ -1539,13 +1540,11 @@ package body Sem_Ch10 is then Error_Msg_Sloc := Sloc (It); Error_Msg_N - ("simultaneous visibility of limited " - & "and unlimited views not allowed", - Item); + ("simultaneous visibility of limited and " + & "unlimited views not allowed", Item); Error_Msg_NE - ("\unlimited view visible through " - & "context clause #", - Item, It); + ("\unlimited view visible through context " + & "clause #", Item, It); exit; elsif Nkind (Unit_Name) = N_Identifier then @@ -1572,15 +1571,15 @@ package body Sem_Ch10 is Analyze (Item); end if; - -- A limited_with does not impose an elaboration order, but - -- there is a semantic dependency for recompilation purposes. + -- A limited_with does not impose an elaboration order, but there + -- is a semantic dependency for recompilation purposes. if not Implicit_With (Item) then Version_Update (N, Library_Unit (Item)); end if; - -- Pragmas and use clauses and with clauses other than limited - -- with's are ignored in this pass through the context items. + -- Pragmas and use clauses and with clauses other than limited with's + -- are ignored in this pass through the context items. else null; @@ -2632,8 +2631,8 @@ package body Sem_Ch10 is Error_Msg_F ("\use ""~"" instead?i?", Name (N)); else Error_Msg_F - ("\use of this unit is non-portable " & - "and version-dependent?i?", Name (N)); + ("\use of this unit is non-portable and " + & "version-dependent?i?", Name (N)); end if; elsif U_Kind = Ada_2005_Unit @@ -2999,7 +2998,7 @@ package body Sem_Ch10 is then Error_Msg_NE ("& is a nested package, not a compilation unit", - Name (Item), Priv_Child); + Name (Item), Priv_Child); else Error_Msg_N @@ -3027,7 +3026,6 @@ package body Sem_Ch10 is Next (Item); end loop; - end Check_Private_Child_Unit; ---------------------- @@ -3063,10 +3061,7 @@ package body Sem_Ch10 is ------------------------ procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id) is - Loc : constant Source_Ptr := Sloc (Nam); - Ent : constant Entity_Id := Entity (Nam); - Withn : Node_Id; - P : Node_Id; + Loc : constant Source_Ptr := Sloc (Nam); function Build_Unit_Name (Nam : Node_Id) return Node_Id; -- Build name to be used in implicit with_clause. In most cases this @@ -3093,8 +3088,8 @@ package body Sem_Ch10 is if Present (Entity (Selector_Name (Nam))) and then Chars (Entity (Selector_Name (Nam))) /= Chars (Ent) and then - Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam)))) - = N_Package_Renaming_Declaration + Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam)))) = + N_Package_Renaming_Declaration then -- The name in the with_clause is of the form A.B.C, and B is -- given by a renaming declaration. In that case we may not @@ -3111,14 +3106,20 @@ package body Sem_Ch10 is Result := Make_Expanded_Name (Loc, - Chars => Chars (Entity (Nam)), - Prefix => Build_Unit_Name (Prefix (Nam)), + Chars => Chars (Entity (Nam)), + Prefix => Build_Unit_Name (Prefix (Nam)), Selector_Name => New_Occurrence_Of (Ent, Loc)); Set_Entity (Result, Ent); + return Result; end if; end Build_Unit_Name; + -- Local variables + + Ent : constant Entity_Id := Entity (Nam); + Withn : Node_Id; + -- Start of processing for Expand_With_Clause begin @@ -3126,18 +3127,18 @@ package body Sem_Ch10 is Make_With_Clause (Loc, Name => Build_Unit_Name (Nam)); - P := Parent (Unit_Declaration_Node (Ent)); - Set_Library_Unit (Withn, P); Set_Corresponding_Spec (Withn, Ent); - Set_First_Name (Withn, True); - Set_Implicit_With (Withn, True); + Set_First_Name (Withn); + Set_Implicit_With (Withn); + Set_Library_Unit (Withn, Parent (Unit_Declaration_Node (Ent))); + Set_Parent_With (Withn); -- If the unit is a package or generic package declaration, a private_ -- with_clause on a child unit implies that the implicit with on the -- parent is also private. - if Nkind_In (Unit (N), N_Package_Declaration, - N_Generic_Package_Declaration) + if Nkind_In (Unit (N), N_Generic_Package_Declaration, + N_Package_Declaration) then Set_Private_Present (Withn, Private_Present (Item)); end if; @@ -3277,8 +3278,8 @@ package body Sem_Ch10 is P_Spec : Node_Id := P; begin - -- Ancestor may have been rewritten as a package body. Retrieve - -- the original spec to trace earlier ancestors. + -- Ancestor may have been rewritten as a package body. Retrieve the + -- original spec to trace earlier ancestors. if Nkind (P) = N_Package_Body and then Nkind (Original_Node (P)) = N_Package_Instantiation @@ -3291,7 +3292,8 @@ package body Sem_Ch10 is else return Make_Selected_Component (Loc, - Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P_Spec))), + Prefix => + Build_Ancestor_Name (Unit (Parent_Spec (P_Spec))), Selector_Name => P_Ref); end if; end Build_Ancestor_Name; @@ -3310,10 +3312,12 @@ package body Sem_Ch10 is else Result := Make_Expanded_Name (Loc, - Chars => Chars (P_Name), - Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P_Unit))), + Chars => Chars (P_Name), + Prefix => + Build_Ancestor_Name (Unit (Parent_Spec (P_Unit))), Selector_Name => New_Occurrence_Of (P_Name, Loc)); Set_Entity (Result, P_Name); + return Result; end if; end Build_Unit_Name; @@ -3343,10 +3347,11 @@ package body Sem_Ch10 is Withn := Make_With_Clause (Loc, Name => Build_Unit_Name); - Set_Library_Unit (Withn, P); - Set_Corresponding_Spec (Withn, P_Name); - Set_First_Name (Withn, True); - Set_Implicit_With (Withn, True); + Set_Corresponding_Spec (Withn, P_Name); + Set_First_Name (Withn); + Set_Implicit_With (Withn); + Set_Library_Unit (Withn, P); + Set_Parent_With (Withn); -- Node is placed at the beginning of the context items, so that -- subsequent use clauses on the parent can be validated. @@ -3913,9 +3918,9 @@ package body Sem_Ch10 is Set_Parent (Withn, Parent (N)); end if; - Set_Limited_Present (Withn); Set_First_Name (Withn); Set_Implicit_With (Withn); + Set_Limited_Present (Withn); Unum := Load_Unit--- gcc/ada/sem_ch12.adb +++ gcc/ada/sem_ch12.adb @@ -9106,8 +9106,8 @@ package body Sem_Ch12 is Clause := First (Current_Context); OK := True; while Present (Clause) loop - if Nkind (Clause) = N_With_Clause and then - Library_Unit (Clause) = Lib_Unit + if Nkind (Clause) = N_With_Clause + and then Library_Unit (Clause) = Lib_Unit then OK := False; exit; @@ -9118,8 +9118,8 @@ package body Sem_Ch12 is if OK then New_I := New_Copy (Item); - Set_Implicit_With (New_I, True); - Set_Implicit_With_From_Instantiation (New_I, True); + Set_Implicit_With (New_I); + Append (New_I, Current_Context); end if; end if;--- gcc/ada/sem_ch8.adb +++ gcc/ada/sem_ch8.adb @@ -8935,16 +8935,17 @@ package body Sem_Ch8 is Make_With_Clause (Loc, Name => Make_Expanded_Name (Loc, - Chars => Chars (System_Aux_Id), - Prefix => New_Occurrence_Of (Scope (System_Aux_Id), Loc), + Chars => Chars (System_Aux_Id), + Prefix => + New_Occurrence_Of (Scope (System_Aux_Id), Loc), Selector_Name => New_Occurrence_Of (System_Aux_Id, Loc))); Set_Entity (Name (Withn), System_Aux_Id); - Set_Library_Unit (Withn, Cunit (Unum)); Set_Corresponding_Spec (Withn, System_Aux_Id); - Set_First_Name (Withn, True); - Set_Implicit_With (Withn, True); + Set_First_Name (Withn); + Set_Implicit_With (Withn); + Set_Library_Unit (Withn, Cunit (Unum)); Insert_After (With_Sys, Withn); Mark_Rewrite_Insertion (Withn);--- gcc/ada/sem_elab.adb +++ gcc/ada/sem_elab.adb @@ -3585,16 +3585,6 @@ package body Sem_Elab is Set_Implicit_With (Clause); Set_Library_Unit (Clause, Unit_Cunit); - -- The following is a kludge to satisfy a GPRbuild requirement. In - -- general, internal with clauses should be encoded on a 'Z' line in - -- ALI files, but due to an old bug, they are encoded as source with - -- clauses on a 'W' line. As a result, these "semi-implicit" clauses - -- introduce spurious build dependencies in GPRbuild. The only way to - -- eliminate this effect is to mark the implicit clauses as generated - -- for an instantiation. - - Set_Implicit_With_From_Instantiation (Clause); - Append_To (Items, Clause); end if; @@ -11717,7 +11707,7 @@ package body Sem_Elab is begin Set_Library_Unit (CW, Library_Unit (Itm)); - Set_Implicit_With (CW, True); + Set_Implicit_With (CW); -- Set elaborate all desirable on copy and then append the copy to -- the list of body with's and we are done.--- gcc/ada/sinfo.adb +++ gcc/ada/sinfo.adb @@ -1680,14 +1680,6 @@ package body Sinfo is 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 @@ -2766,6 +2758,14 @@ package body Sinfo is return Node4 (N); end Parent_Spec; + function Parent_With + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + return Flag1 (N); + end Parent_With; + function Position (N : Node_Id) return Node_Id is begin @@ -5147,14 +5147,6 @@ package body Sinfo is 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 @@ -6233,6 +6225,14 @@ package body Sinfo is Set_Node4 (N, Val); -- semantic field, no parent set end Set_Parent_Spec; + procedure Set_Parent_With + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + Set_Flag1 (N, Val); + end Set_Parent_With; + procedure Set_Position (N : Node_Id; Val : Node_Id) is begin--- gcc/ada/sinfo.ads +++ gcc/ada/sinfo.ads @@ -1589,25 +1589,32 @@ package Sinfo is -- expansion of the same attribute in the said context. -- Hidden_By_Use_Clause (Elist5-Sem) - -- An entity list present in use clauses that appear within - -- instantiations. For the resolution of local entities, entities - -- introduced by these use clauses have priority over global ones, and - -- outer entities must be explicitly hidden/restored on exit. + -- An entity list present in use clauses that appear within + -- instantiations. For the resolution of local entities, entities + -- introduced by these use clauses have priority over global ones, + -- and outer entities must be explicitly hidden/restored on exit. -- Implicit_With (Flag16-Sem) - -- This flag is set in the N_With_Clause node that is implicitly - -- generated for runtime units that are loaded by the expander or in - -- GNATprove mode, and also for package System, if it is loaded - -- implicitly by a use of the '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. + -- Present in N_With_Clause nodes. The flag indicates that the clause + -- does not comes from source and introduces an implicit dependency on + -- a particular unit. Such implicit with clauses are generated by: + -- + -- * ABE mechanism - The static elaboration model of both the default + -- and the legacy ABE mechanism use with clauses to encode implicit + -- Elaborate[_All] pragmas. + -- + -- * Analysis - A with clause for child unit A.B.C is equivalent to + -- a series of clauses that with A, A.B, and A.B.C. Manipulation of + -- contexts utilizes implicit with clauses to emulate the visibility + -- of a particular unit. + -- + -- * RTSfind - The compiler generates code which references entities + -- from the runtime. -- 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 - -- generating some unwanted error messages. + -- 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 + -- generating some unwanted error messages. -- Includes_Infinities (Flag11-Sem) -- This flag is present in N_Range nodes. It is set for the range of @@ -2217,6 +2224,12 @@ package Sinfo is -- package specification. This field is Empty for library bodies (the -- parent spec in this case can be found from the corresponding spec). + -- Parent_With (Flag1-Sem) + -- Present in N_With_Clause nodes. The flag indicates that the clause + -- was generated for an ancestor unit to provide proper visibility. A + -- with clause for child unit A.B.C produces two implicit parent with + -- clauses for A and A.B. + -- Premature_Use (Node5-Sem) -- Present in N_Incomplete_Type_Declaration node. Used for improved -- error diagnostics: if there is a premature usage of an incomplete @@ -6748,6 +6761,8 @@ package Sinfo is -- Sloc points to first token of library unit name -- Withed_Body (Node1-Sem) -- Name (Node2) + -- Private_Present (Flag15) set if with_clause has private keyword + -- Limited_Present (Flag17) set if LIMITED is present -- Next_Implicit_With (Node3-Sem) -- Library_Unit (Node4-Sem) -- Corresponding_Spec (Node5-Sem) @@ -6758,11 +6773,9 @@ package Sinfo is -- Elaborate_All_Present (Flag14-Sem) -- Elaborate_All_Desirable (Flag9-Sem) -- 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) + -- Parent_With (Flag1-Sem) -- Unreferenced_In_Spec (Flag7-Sem) -- No_Entities_Ref_In_Spec (Flag8-Sem) @@ -9736,9 +9749,6 @@ package Sinfo is 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 @@ -10072,6 +10082,9 @@ package Sinfo is function Parent_Spec (N : Node_Id) return Node_Id; -- Node4 + function Parent_With + (N : Node_Id) return Boolean; -- Flag1 + function Position (N : Node_Id) return Node_Id; -- Node2 @@ -10837,9 +10850,6 @@ package Sinfo is 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 @@ -11173,6 +11183,9 @@ package Sinfo is procedure Set_Parent_Spec (N : Node_Id; Val : Node_Id); -- Node4 + procedure Set_Parent_With + (N : Node_Id; Val : Boolean := True); -- Flag1 + procedure Set_Position (N : Node_Id; Val : Node_Id); -- Node2 @@ -13438,7 +13451,6 @@ package Sinfo is 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); @@ -13552,6 +13564,7 @@ package Sinfo is pragma Inline (Parameter_Specifications); pragma Inline (Parameter_Type); pragma Inline (Parent_Spec); + pragma Inline (Parent_With); pragma Inline (Position); pragma Inline (Pragma_Argument_Associations); pragma Inline (Pragma_Identifier); @@ -13915,6 +13928,7 @@ package Sinfo is pragma Inline (Set_Parameter_Specifications); pragma Inline (Set_Parameter_Type); pragma Inline (Set_Parent_Spec); + pragma Inline (Set_Parent_With); pragma Inline (Set_Position); pragma Inline (Set_Pragma_Argument_Associations); pragma Inline (Set_Pragma_Identifier);