From: Hristian Kirtchev Date: Thu, 11 Jan 2018 08:51:13 +0000 (+0000) Subject: [Ada] Encoding of with clauses in ALI files X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=94ce49419aef75f3414edcaeba89e63c6c3be320;p=gcc.git [Ada] Encoding of with clauses in ALI files 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 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. From-SVN: r256490 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d05467d69f9..550b7608497 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2018-01-11 Hristian Kirtchev + + * 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. + 2018-01-11 Hristian Kirtchev * sem_util.adb (Find_Enclosing_Scope): Return the unique defining diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 959b3058728..b40e8cf6dd4 100644 --- a/gcc/ada/ali.adb +++ b/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 diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 3fa4d99fb09..60454abeade 100644 --- a/gcc/ada/ali.ads +++ b/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 diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb index 1a71a2ef6db..c6608995c6f 100644 --- a/gcc/ada/csinfo.adb +++ b/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); diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 1ee329ee7f1..553bda20b5f 100644 --- a/gcc/ada/lib-writ.adb +++ b/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; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index e3af27d31f4..879eb45a4af 100644 --- a/gcc/ada/rtsfind.adb +++ b/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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 0616a201b79..4b828c9f4f0 100644 --- a/gcc/ada/sem_ch10.adb +++ b/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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 0865f7b70d8..0cfb4119104 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 955db28d97d..27e55abe7ae 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 90746b4862e..078c1e483f4 100644 --- a/gcc/ada/sem_elab.adb +++ b/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. diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 1790b56ff4c..c1193d717d6 100644 --- a/gcc/ada/sinfo.adb +++ b/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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 19585936c49..0702f3c6001 100644 --- a/gcc/ada/sinfo.ads +++ b/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);