@@ -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
@@ -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
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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);
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 <kirtchev@adacore.com> 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.