diff options
| author | Bob Duff <duff@adacore.com> | 2024-10-17 12:04:45 -0400 |
|---|---|---|
| committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-11-04 16:57:59 +0100 |
| commit | 16007e34ef4019f7cba9c9b718f5e43cc045e920 (patch) | |
| tree | c5ed4f4e1f4d3cd772a61edc2aef17e7493fa3f1 /gcc | |
| parent | f6a8c07743d74430da761e3ca7a8516ac663ef94 (diff) | |
| download | gcc-16007e34ef4019f7cba9c9b718f5e43cc045e920.zip gcc-16007e34ef4019f7cba9c9b718f5e43cc045e920.tar.gz gcc-16007e34ef4019f7cba9c9b718f5e43cc045e920.tar.bz2 | |
ada: Split Library_Unit using multiple wrappers
The Library_Unit field was used for all sorts of different purposes,
which led to confusing code.
This patch splits Library_Unit into much more specific wrapper
subprograms that should be called instead of [Set_]Library_Unit.
Predicates and pragmas Assert are used to catch misuses of these.
We document the semantics, especially "surprising" cases (e.g.
internally-generated with clauses can refer to package bodies).
This change does not fix gigi, codepeer, spark, or llvm
to use the new wrappers; so far, they are used only in
the GNAT front end.
gcc/ada/ChangeLog:
* sinfo.ads (Library_Unit): Rewrite documentation. Note that
the "??? not (always) true..." comment was not true;
the Subunit_Parent never points to the spec.
(N_Compilation_Unit): Improve documentation. The Aux_ node
was not created to solve the mentioned problems; it was
created because the size of nodes was limited.
Misc doc improvements.
* sinfo-utils.ads: Add new wrappers for Library_Unit field.
Use subtypes with predicates for the parameters.
(First_Real_Statement): Still used in codepeer.
* sinfo-utils.adb: Add new wrappers for Library_Unit field,
with suitable assertions.
* sem_prag.adb: Use new field wrapper names.
(Matching_Name): New name for Same_Name to avoid
potential confusion with the other function with the
same name (Sem_Util.Same_Name), which is also called
in this same file.
(Matching_Convention): Change Same_Convention to match
Matching_Name.
* sem_util.ads (Same_Name): Improve comments; the old comment
implied that it works for all names, which was not true.
* sem_util.adb: Use new field wrapper names.
* gen_il-gen.adb: Rename N_Unit_Body to be N_Lib_Unit_Body.
Plain "unit" is ambiguous in Ada (library unit, compilation
unit, program unit, etc).
Add new union types N_Lib_Unit_Declaration and
N_Lib_Unit_Renaming_Declaration.
* gen_il-gen-gen_nodes.adb (Compute_Ranges): Raise exception
earlier (it is already raised later, in Verify_Type_Table).
Add a comment explaining why it might be raised.
* gen_il-types.ads: Rename N_Unit_Body to be N_Lib_Unit_Body, and add
new N_Lib_Unit_Declaration and N_Lib_Unit_Renaming_Declaration.
* einfo.ads: Fix obsolete comment (was left over from before
the "variable-sized nodes").
* exp_ch7.adb: Use new field wrapper names.
* exp_disp.adb: Use new field wrapper names.
* exp_unst.adb: Use new field wrapper names.
* exp_util.adb: Use new field wrapper names.
* fe.h: Add new field wrapper names. These are currently not
used in gigi, but this change prepares for using them in
gigi.
* inline.adb: Use new field wrapper names.
* lib.adb: Use new field wrapper names.
Comment improvements.
* lib-load.adb: Use new field wrapper names.
Minor cleanup.
* lib-writ.adb: Use new field wrapper names.
* live.adb: Use new field wrapper names.
* par-load.adb: Use new field wrapper names.
Comment improvements. Minor cleanup.
* rtsfind.adb: Use new field wrapper names.
* sem.adb: Use new field wrapper names.
* sem_ch10.adb: Use new field wrapper names.
Comment improvements. Minor cleanup.
* sem_ch12.adb: Use new field wrapper names.
* sem_ch7.adb: Use new field wrapper names.
* sem_ch8.adb: Use new field wrapper names.
* sem_elab.adb: Use new field wrapper names.
Comment improvements.
* errout.adb (Output_Source_Line): Fix blowup in some
obscure cases, where List_Pragmas is not fully set up.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/einfo.ads | 15 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_unst.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/fe.h | 10 | ||||
| -rw-r--r-- | gcc/ada/gen_il-gen-gen_nodes.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/gen_il-gen.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/gen_il-types.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/live.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/par-load.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 194 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sinfo-utils.adb | 139 | ||||
| -rw-r--r-- | gcc/ada/sinfo-utils.ads | 63 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 66 |
29 files changed, 542 insertions, 295 deletions
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 2aae60a..f0ae45c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -251,15 +251,12 @@ package Einfo is -- kinds of entities. In the latter case the attribute should only be set or -- accessed if the Ekind field indicates an appropriate entity. --- There are two kinds of attributes that apply to entities, stored and --- synthesized. Stored attributes correspond to a field or flag in the entity --- itself. Such attributes are identified in the table below by giving the --- field or flag in the attribute that is used to hold the attribute value. --- Synthesized attributes are not stored directly, but are rather computed as --- needed from other attributes, or from information in the tree. These are --- marked "synthesized" in the table below. The stored attributes have both --- access functions and set procedures to set the corresponding values, while --- synthesized attributes have only access functions. +-- Attributes that apply to entities are either "stored" or "synthesized". +-- Stored attributes are stored as fields in the entity node, and have +-- automatically-generated access functions and Set_... procedures. +-- Synthesized attributes are marked "(synthesized)" in the documentation +-- below, and are computed as needed; these have only (hand-written) access +-- functions. -- Note: in the case of Node, Uint, or Elist fields, there are cases where the -- same physical field is used for different purposes in different entities, diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 81919a3..21c8adf 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3552,7 +3552,8 @@ package body Errout is -- Deal with matching entry in List_Pragmas table if Full_List - and then List_Pragmas_Index <= List_Pragmas.Last + and then List_Pragmas_Index in + List_Pragmas.First .. List_Pragmas.Last and then S = List_Pragmas.Table (List_Pragmas_Index).Ploc then case List_Pragmas.Table (List_Pragmas_Index).Ptyp is diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 640ad5c..f403713 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2672,9 +2672,10 @@ package body Exp_Ch7 is Process_Package_Body (Decl); elsif Nkind (Decl) = N_Package_Body_Stub - and then Present (Library_Unit (Decl)) + and then Present (Stub_Subunit (Decl)) then - Process_Package_Body (Proper_Body (Unit (Library_Unit (Decl)))); + Process_Package_Body + (Proper_Body (Unit (Stub_Subunit (Decl)))); end if; Decl := Prev; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index c367181..f250117 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -417,10 +417,10 @@ package body Exp_Disp is Build_Dispatch_Tables (Declarations (D)); elsif Nkind (D) = N_Package_Body_Stub - and then Present (Library_Unit (D)) + and then Present (Stub_Subunit (D)) then Build_Dispatch_Tables - (Declarations (Proper_Body (Unit (Library_Unit (D))))); + (Declarations (Proper_Body (Unit (Stub_Subunit (D))))); -- Handle full type declarations and derivations of library level -- tagged types diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index fb48a64..9b76cba 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1176,7 +1176,7 @@ package body Exp_Unst is -- is a semantic descendant of the stub. when N_Body_Stub => - Visit (Library_Unit (N)); + Visit (Stub_Subunit (N)); -- A declaration of a wrapper package indicates a subprogram -- instance for which there is no explicit body. Enter the @@ -2354,7 +2354,7 @@ package body Exp_Unst is -- recursively in Visit_Node. elsif Nkind (N) in N_Body_Stub then - Do_Search (Library_Unit (N)); + Do_Search (Stub_Subunit (N)); -- Skip generic packages @@ -2385,7 +2385,7 @@ package body Exp_Unst is or else (Nkind (Unit (N)) = N_Subprogram_Body and then not Acts_As_Spec (N)) then - Do_Search (Library_Unit (N)); + Do_Search (Spec_Lib_Unit (N)); end if; Do_Search (N); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4029ea6..b400505 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5006,7 +5006,7 @@ package body Exp_Util is -- declarations of the package spec. if Nkind (U) = N_Package_Body then - U := Unit (Library_Unit (Cunit (Current_Sem_Unit))); + U := Unit (Spec_Lib_Unit (Cunit (Current_Sem_Unit))); end if; if Nkind (U) = N_Package_Declaration then diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index e3e65fe..bb40ca3 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -337,10 +337,20 @@ extern Entity_Id Storage_Model_Copy_To (Entity_Id); /* sinfo: */ +#define Spec_Lib_Unit sinfo__utils__spec_lib_unit +#define Body_Lib_Unit sinfo__utils__body_lib_unit +#define Subunit_Parent sinfo__utils__subunit_parent +#define Stub_Subunit sinfo__utils__stub_subunit +#define Withed_Lib_Unit sinfo__utils__withed_lib_unit #define End_Location sinfo__utils__end_location #define Set_Has_No_Elaboration_Code sinfo__nodes__set_has_no_elaboration_code #define Set_Present_Expr sinfo__nodes__set_present_expr +extern Node_Id Spec_Lib_Unit (Node_Id); +extern Node_Id Body_Lib_Unit (Node_Id); +extern Node_Id Subunit_Parent (Node_Id); +extern Node_Id Stub_Subunit (Node_Id); +extern Node_Id Withed_Lib_Unit (Node_Id); extern Source_Ptr End_Location (Node_Id); extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean); extern void Set_Present_Expr (Node_Id, Uint); diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index a9c0fa4..e0e0538 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -835,16 +835,16 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sm (Corresponding_Spec, Node_Id), Sm (Was_Originally_Stub, Flag))); - Ab (N_Unit_Body, N_Proper_Body); + Ab (N_Lib_Unit_Body, N_Proper_Body); - Cc (N_Package_Body, N_Unit_Body, + Cc (N_Package_Body, N_Lib_Unit_Body, (Sy (Defining_Unit_Name, Node_Id), Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), Sy (Aspect_Specifications, List_Id, Default_No_List))); - Cc (N_Subprogram_Body, N_Unit_Body, + Cc (N_Subprogram_Body, N_Lib_Unit_Body, (Sy (Specification, Node_Id), Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), @@ -1792,4 +1792,20 @@ begin -- Gen_IL.Gen.Gen_Nodes N_Variant)); -- Nodes that can be alternatives in case contructs + Union (N_Lib_Unit_Declaration, + Children => + (N_Package_Declaration, + N_Subprogram_Declaration, + N_Generic_Declaration, + N_Generic_Instantiation)); + -- Nodes corresponding to the library_unit_declaration syntactic category + + Union (N_Lib_Unit_Renaming_Declaration, + Children => + (N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration, + N_Generic_Renaming_Declaration)); + -- Nodes corresponding to the library_unit_renaming_declaration syntactic + -- category. + end Gen_IL.Gen.Gen_Nodes; diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb index 0f7abe7..da7e96e 100644 --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -734,6 +734,15 @@ package body Gen_IL.Gen is Type_Table (T).First := Type_Table (Children (1)).First; Type_Table (T).Last := Type_Table (Children (Last_Index (Children))).Last; + + -- We know that each abstract type has at least two + -- children. The concrete types must be ordered so + -- that each abstract type is a contiguous subrange. + + if Type_Table (T).First >= Type_Table (T).Last then + raise Illegal with + Image (T) & " children out of order"; + end if; end; when Between_Abstract_Entity_And_Concrete_Node_Types => diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads index f2a6595..4a739043 100644 --- a/gcc/ada/gen_il-types.ads +++ b/gcc/ada/gen_il-types.ads @@ -124,7 +124,9 @@ package Gen_IL.Types is N_Subexpr, N_Subprogram_Specification, N_Unary_Op, - N_Unit_Body, + N_Lib_Unit_Declaration, + N_Lib_Unit_Renaming_Declaration, + N_Lib_Unit_Body, -- End of abstract node types. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 5f310ab..9fa5642 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -498,7 +498,7 @@ package body Inline is -- package of the subprogram to find more calls to be inlined. if Comp = Cunit (Main_Unit) - or else Comp = Library_Unit (Cunit (Main_Unit)) + or else Comp = Spec_Or_Body_Lib_Unit (Cunit (Main_Unit)) then Add_Call (E); return Inline_Package; @@ -2897,7 +2897,7 @@ package body Inline is then Child_Spec := Defining_Entity - ((Unit (Library_Unit (Cunit (Main_Unit))))); + ((Unit (Spec_Lib_Unit (Cunit (Main_Unit))))); Comp := Parent (Unit_Declaration_Node (Body_Entity (P))); @@ -4712,11 +4712,11 @@ package body Inline is -- done in Analyze_Inlined_Bodies. while Nkind (Unit (Comp)) = N_Subunit loop - Comp := Library_Unit (Comp); + Comp := Subunit_Parent (Comp); end loop; return Comp = Cunit (Main_Unit) - or else Comp = Library_Unit (Cunit (Main_Unit)); + or else Comp = Spec_Or_Body_Lib_Unit (Cunit (Main_Unit)); end In_Main_Unit_Or_Subunit; ---------------- diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 06da369..c885064 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -948,7 +948,7 @@ package body Lib.Load is -------------------------- procedure Make_Child_Decl_Unit (N : Node_Id) is - Unit_Decl : constant Node_Id := Library_Unit (N); + Unit_Decl : constant Node_Id := Spec_Lib_Unit (N); Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (N); begin @@ -988,14 +988,14 @@ package body Lib.Load is if In_Main then Units.Table (Units.Last) := Units.Table (Main_Unit); - Units.Table (Units.Last).Cunit := Library_Unit (N); + Units.Table (Units.Last).Cunit := Spec_Lib_Unit (N); Init_Unit_Name (Units.Last, Unit_Name (Main_Unit)); Units.Table (Main_Unit).Cunit := N; Units.Table (Main_Unit).Version := Source_Checksum (Sind); Init_Unit_Name (Main_Unit, Get_Body_Name - (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))))); + (Unit_Name (Get_Cunit_Unit_Number (Spec_Lib_Unit (N))))); else -- Duplicate information from instance unit, for the body. The unit @@ -1003,7 +1003,7 @@ package body Lib.Load is -- units table when first loaded as a declaration. Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N)); - Units.Table (Units.Last).Cunit := Library_Unit (N); + Units.Table (Units.Last).Cunit := Spec_Lib_Unit (N); end if; end Make_Instance_Unit; diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 23de685..e6bfbf1 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -339,7 +339,7 @@ package body Lib.Writ is -- the unit anywhere else. if Nkind (Item) = N_With_Clause then - Unum := Get_Cunit_Unit_Number (Library_Unit (Item)); + Unum := Get_Cunit_Unit_Number (Withed_Lib_Unit (Item)); With_Flags (Unum) := True; if not Limited_Present (Item) then @@ -594,9 +594,10 @@ package body Lib.Writ is if Ukind in N_Generic_Declaration or else - (Present (Library_Unit (Unode)) - and then - Nkind (Unit (Library_Unit (Unode))) in N_Generic_Declaration) + (Ukind in N_Lib_Unit_Body + and then Present (Spec_Lib_Unit (Unode)) + and then Nkind (Unit (Spec_Lib_Unit (Unode))) + in N_Generic_Declaration) then Write_Info_Str (" GE"); end if; @@ -638,7 +639,7 @@ package body Lib.Writ is -- it and which have context clauses of their own, since these -- with'ed units are part of its own elaboration dependencies. - if Nkind (Unit (Unode)) in N_Unit_Body then + if Nkind (Unit (Unode)) in N_Lib_Unit_Body then for S in Units.First .. Last_Unit loop -- We are only interested in subunits. For preproc. data and @@ -647,7 +648,7 @@ package body Lib.Writ is if Cunit (S) /= Empty and then Nkind (Unit (Cunit (S))) = N_Subunit then - Pnode := Library_Unit (Cunit (S)); + Pnode := Subunit_Parent (Cunit (S)); -- In gnatc mode, the errors in the subunits will not have -- been recorded, but the analysis of the subunit may have @@ -661,7 +662,7 @@ package body Lib.Writ is -- Find ultimate parent of the subunit while Nkind (Unit (Pnode)) = N_Subunit loop - Pnode := Library_Unit (Pnode); + Pnode := Subunit_Parent (Pnode); end loop; -- See if it belongs to current unit, and if so, include @@ -1169,7 +1170,7 @@ package body Lib.Writ is if Nkind (U) = N_Package_Body then U := Parent (Parent ( Alias (Related_Instance (Defining_Unit_Name - (Specification (Unit (Library_Unit (Parent (U))))))))); + (Specification (Unit (Spec_Lib_Unit (Parent (U))))))))); end if; S := Specification (U); diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 24255da..9539a47 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -36,6 +36,7 @@ with Opt; use Opt; with Output; use Output; with Sinfo; use Sinfo; with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Stand; use Stand; with Stringt; use Stringt; @@ -481,12 +482,12 @@ package body Lib is -- earlier. if Nkind (Unit1) in N_Subprogram_Body | N_Package_Body then - if Library_Unit (Cunit (Unum1)) = Cunit (Unum2) then + if Spec_Lib_Unit (Cunit (Unum1)) = Cunit (Unum2) then return Yes_After; end if; elsif Nkind (Unit2) in N_Subprogram_Body | N_Package_Body then - if Library_Unit (Cunit (Unum2)) = Cunit (Unum1) then + if Spec_Lib_Unit (Cunit (Unum2)) = Cunit (Unum1) then return Yes_Before; end if; end if; @@ -779,10 +780,16 @@ package body Lib is end if; end loop; - -- If not in the table, must be a spec created for a main unit that is a - -- child subprogram body which we have not inserted into the table yet. + -- Not in the table. Empty N is some already-detected error; otherwise, + -- it must be a spec created for a main unit that is a child subprogram + -- body which we have not inserted into the table yet. - if N = Library_Unit (Cunit (Main_Unit)) then + if No (N) then + pragma Assert (Serious_Errors_Detected > 0); + return Main_Unit; + end if; + + if N = Spec_Lib_Unit (Cunit (Main_Unit)) then return Main_Unit; -- If it is anything else, something is seriously wrong, and we really @@ -1330,10 +1337,11 @@ package body Lib is if Nkind (Context_Item) = N_With_Clause and then not Limited_Present (Context_Item) then - pragma Assert (Present (Library_Unit (Context_Item))); + pragma Assert (Present (Withed_Lib_Unit (Context_Item))); Write_Unit_Name (Unit_Name - (Get_Cunit_Unit_Number (Library_Unit (Context_Item)))); + (Get_Cunit_Unit_Number + (Withed_Lib_Unit (Context_Item)))); if Is_Implicit_With (Context_Item) then Write_Str (" -- implicit"); diff --git a/gcc/ada/live.adb b/gcc/ada/live.adb index 7707220..1001427 100644 --- a/gcc/ada/live.adb +++ b/gcc/ada/live.adb @@ -156,8 +156,8 @@ package body Live is Traverse (Spec_Of (N)); when N_Package_Body_Stub => - if Present (Library_Unit (N)) then - Traverse (Proper_Body (Unit (Library_Unit (N)))); + if Present (Subunit_Parent (N)) then + Traverse (Proper_Body (Unit (Stub_Subunit (N)))); end if; when N_Package_Body => @@ -252,8 +252,8 @@ package body Live is Traverse (Spec_Of (N)); when N_Package_Body_Stub => - if Present (Library_Unit (N)) then - Traverse (Proper_Body (Unit (Library_Unit (N)))); + if Present (Stub_Subunit (N)) then + Traverse (Proper_Body (Unit (Stub_Subunit (N)))); end if; when N_Package_Body => @@ -321,8 +321,8 @@ package body Live is end if; when N_Package_Body_Stub => - if Present (Library_Unit (N)) then - Traverse (Proper_Body (Unit (Library_Unit (N)))); + if Present (Stub_Subunit (N)) then + Traverse (Proper_Body (Unit (Stub_Subunit (N)))); end if; when N_Expanded_Name diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index 45be02c..dbb123e 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.adb @@ -258,8 +258,8 @@ begin -- have set our Fatal_Error flag to propagate this condition. if Unum /= No_Unit then - Set_Library_Unit (Curunit, Cunit (Unum)); - Set_Library_Unit (Cunit (Unum), Curunit); + Set_Spec_Lib_Unit (Curunit, Cunit (Unum)); + Set_Body_Lib_Unit (Cunit (Unum), Curunit); -- If this is a separate spec for the main unit, then we reset -- Main_Unit_Entity to point to the entity for this separate spec @@ -284,7 +284,7 @@ begin elsif Nkind (Unit (Curunit)) = N_Subprogram_Body then Set_Acts_As_Spec (Curunit, True); - Set_Library_Unit (Curunit, Curunit); + Set_Spec_Lib_Unit (Curunit, Curunit); -- Otherwise we do have an error, repeat the load request for the spec -- with Required set True to generate an appropriate error message. @@ -341,7 +341,7 @@ begin Error_Node => Name (Unit (Curunit))); if Unum /= No_Unit then - Set_Library_Unit (Curunit, Cunit (Unum)); + Set_Subunit_Parent (Curunit, Cunit (Unum)); end if; end if; @@ -397,7 +397,7 @@ begin -- unit gets a fatal error, so we don't need to worry about that. if Unum /= No_Unit then - Set_Library_Unit (With_Node, Cunit (Unum)); + Set_Withed_Lib_Unit (With_Node, Cunit (Unum)); -- If the spec isn't found, then try finding the corresponding -- body, since it is possible that we have a subprogram body @@ -414,16 +414,29 @@ begin Renamings => True); -- If we got a subprogram body, then mark that we are using - -- the body as a spec in the file table, and set the spec - -- pointer in the N_With_Clause to point to the body entity. + -- the body as a spec in the file table, and set + -- Withed_Lib_Unit of the N_With_Clause to point to + -- the body entity. if Unum /= No_Unit and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body then With_Cunit := Cunit (Unum); - Set_Library_Unit (With_Node, With_Cunit); - Set_Acts_As_Spec (With_Cunit, True); - Set_Library_Unit (With_Cunit, With_Cunit); + Set_Withed_Lib_Unit (With_Node, With_Cunit); + + -- If we have errors, Acts_As_Spec and Spec_Lib_Unit might + -- not be set; set them for better error recovery. + + if Serious_Errors_Detected > 0 then + Set_Acts_As_Spec (With_Cunit, True); + Set_Spec_Lib_Unit (With_Cunit, With_Cunit); + + -- Otherwise, these field should already by set + + else + pragma Assert (Acts_As_Spec (With_Cunit)); + pragma Assert (Spec_Lib_Unit (With_Cunit) = With_Cunit); + end if; -- If we couldn't find the body, or if it wasn't a body spec -- then we are in trouble. We make one more call to Load to @@ -443,7 +456,7 @@ begin -- Here we create a dummy package unit for the missing unit Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name); - Set_Library_Unit (With_Node, Cunit (Unum)); + Set_Withed_Lib_Unit (With_Node, Cunit (Unum)); end if; end if; end if; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index f555b99..01f1be2 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -1310,11 +1310,11 @@ package body Rtsfind is (U, Defining_Unit_Name (Specification (LibUnit)))); Ghost_Mode := Saved_GM; - Set_Corresponding_Spec (Withn, U.Entity); - Set_First_Name (Withn); - Set_Is_Implicit_With (Withn); - Set_Library_Unit (Withn, Cunit (U.Unum)); - Set_Next_Implicit_With (Withn, U.First_Implicit_With); + Set_Corresponding_Spec (Withn, U.Entity); + Set_First_Name (Withn); + Set_Is_Implicit_With (Withn); + Set_Withed_Lib_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.adb b/gcc/ada/sem.adb index 915a1cc..fd52e3a 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1530,7 +1530,7 @@ package body Sem is Curunit = Main_Unit or else (Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body - and then Library_Unit (Cunit (Main_Unit)) = Cunit (Curunit)); + and then Spec_Lib_Unit (Cunit (Main_Unit)) = Cunit (Curunit)); -- Configuration flags have special settings when compiling a predefined -- file as a main unit. This applies to its spec as well. @@ -1841,8 +1841,8 @@ package body Sem is while Present (CL) loop if Nkind (CL) = N_With_Clause - and then Library_Unit (CL) = Main_CU - and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL))) + and then Withed_Lib_Unit (CL) = Main_CU + and then not Done (Get_Cunit_Unit_Number (Withed_Lib_Unit (CL))) then return True; end if; @@ -2025,9 +2025,9 @@ package body Sem is if Nkind (Unit (Withed_Unit)) = N_Package_Body and then Is_Generic_Instance - (Defining_Entity (Unit (Library_Unit (Withed_Unit)))) + (Defining_Entity (Unit (Spec_Lib_Unit (Withed_Unit)))) then - Do_Withed_Unit (Library_Unit (Withed_Unit)); + Do_Withed_Unit (Spec_Lib_Unit (Withed_Unit)); end if; end Do_Withed_Unit; @@ -2062,7 +2062,7 @@ package body Sem is else Seen (Unit_Num) := True; - if CU = Library_Unit (Main_CU) then + if CU = Spec_Or_Body_Lib_Unit (Main_CU) then Process_Bodies_In_Context (CU); -- If main is a child unit, examine parent unit contexts @@ -2122,8 +2122,8 @@ package body Sem is Clause := First (Context_Items (Comp)); while Present (Clause) loop if Nkind (Clause) = N_With_Clause then - Spec := Library_Unit (Clause); - Body_CU := Library_Unit (Spec); + Spec := Withed_Lib_Unit (Clause); + Body_CU := Body_Lib_Unit (Spec); -- If we are processing the spec of the main unit, load bodies -- only if the with_clause indicates that it forced the loading @@ -2183,7 +2183,7 @@ package body Sem is and then Is_Generic_Instance (Defining_Entity (N)) then Append_List - (Context_Items (CU), Context_Items (Library_Unit (CU))); + (Context_Items (CU), Context_Items (Spec_Lib_Unit (CU))); end if; Next_Elmt (Cur); @@ -2233,11 +2233,11 @@ package body Sem is if CU = Main_CU and then Nkind (Original_Node (Unit (Main_CU))) in N_Generic_Instantiation - and then Present (Library_Unit (Main_CU)) + and then Present (Spec_Lib_Unit (Main_CU)) then Do_Unit_And_Dependents - (Library_Unit (Main_CU), - Unit (Library_Unit (Main_CU))); + (Spec_Lib_Unit (Main_CU), + Unit (Spec_Lib_Unit (Main_CU))); end if; -- It is a spec, process it, and the units it depends on, @@ -2257,7 +2257,7 @@ package body Sem is -- after all other specs. if Nkind (Unit (CU)) = N_Package_Declaration - and then Library_Unit (CU) = Main_CU + and then Body_Lib_Unit (CU) = Main_CU and then CU /= Main_CU then Spec_CU := CU; @@ -2316,7 +2316,7 @@ package body Sem is begin if Present (U) and then Nkind (Unit (U)) = N_Subunit then - Lib := Library_Unit (U); + Lib := Subunit_Parent (U); return Lib = Main_CU or else Is_Subunit_Of_Main (Lib); else return False; @@ -2346,7 +2346,7 @@ package body Sem is while Is_Child_Unit (Child) loop Parent_CU := Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child))); - Body_CU := Library_Unit (Parent_CU); + Body_CU := Body_Lib_Unit (Parent_CU); if Present (Body_CU) and then not Seen (Get_Cunit_Unit_Number (Body_CU)) @@ -2418,7 +2418,7 @@ package body Sem is -- and which have context clauses of their own, since these with'ed -- units are part of its own dependencies. - if Nkind (Unit (CU)) in N_Unit_Body then + if Nkind (Unit (CU)) in N_Lib_Unit_Body then for S in Main_Unit .. Last_Unit loop -- We are only interested in subunits. For preproc. data and def. @@ -2431,7 +2431,7 @@ package body Sem is Pnode : Node_Id; begin - Pnode := Library_Unit (Cunit (S)); + Pnode := Subunit_Parent (Cunit (S)); -- In -gnatc mode, the errors in the subunits will not have -- been recorded, but the analysis of the subunit may have @@ -2444,7 +2444,7 @@ package body Sem is -- Find ultimate parent of the subunit while Nkind (Unit (Pnode)) = N_Subunit loop - Pnode := Library_Unit (Pnode); + Pnode := Subunit_Parent (Pnode); end loop; -- See if it belongs to current unit, and if so, include its @@ -2476,7 +2476,7 @@ package body Sem is and then (Include_Limited or else not Limited_Present (Context_Item)) then - Lib_Unit := Library_Unit (Context_Item); + Lib_Unit := Withed_Lib_Unit (Context_Item); Action (Lib_Unit); end if; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 4e58244..8499178 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -706,12 +706,12 @@ package body Sem_Ch10 is Install_Parent_Policy_Pragmas (Parent_Spec (Lib_Unit)); elsif Nkind (Lib_Unit) = N_Package_Body then - Install_Parent_Policy_Pragmas (Library_Unit (N)); + Install_Parent_Policy_Pragmas (Spec_Lib_Unit (N)); elsif Nkind (Lib_Unit) = N_Subprogram_Body and then not Acts_As_Spec (N) then - Install_Parent_Policy_Pragmas (Library_Unit (N)); + Install_Parent_Policy_Pragmas (Spec_Lib_Unit (N)); end if; -- Search for check policy pragmas defined at the start of the @@ -768,12 +768,12 @@ package body Sem_Ch10 is Install_Parent_Policy_Pragmas (Parent_Spec (Lib_Unit)); elsif Nkind (Lib_Unit) = N_Package_Body then - Install_Parent_Policy_Pragmas (Library_Unit (Comp_Unit)); + Install_Parent_Policy_Pragmas (Spec_Lib_Unit (Comp_Unit)); elsif Nkind (Lib_Unit) = N_Subprogram_Body and then not Acts_As_Spec (Comp_Unit) then - Install_Parent_Policy_Pragmas (Library_Unit (Comp_Unit)); + Install_Parent_Policy_Pragmas (Spec_Lib_Unit (Comp_Unit)); end if; return Last_Policy_Pragma; @@ -823,7 +823,7 @@ package body Sem_Ch10 is -- Local variables Main_Cunit : constant Node_Id := Cunit (Main_Unit); - Lib_Unit : Node_Id := Library_Unit (N); + Lib_Unit : Node_Id := Other_Comp_Unit (N); Par_Spec_Name : Unit_Name_Type; Spec_Id : Entity_Id; Unum : Unit_Number_Type; @@ -979,7 +979,7 @@ package body Sem_Ch10 is -- If the subprogram body is a child unit, we must create a -- declaration for it, in order to properly load the parent(s). - -- After this, the original unit does not acts as a spec, because + -- After this, the original unit does not act as a spec, because -- there is an explicit one. If this unit appears in a context -- clause, then an implicit with on the parent will be added when -- installing the context. If this is the main unit, there is no @@ -1040,7 +1040,7 @@ package body Sem_Ch10 is Make_Compilation_Unit_Aux (Loc)); Set_Context_Items (N, Empty_List); - Set_Library_Unit (N, Lib_Unit); + Set_Spec_Lib_Unit (N, Lib_Unit); Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum)); Make_Child_Decl_Unit (N); @@ -1685,14 +1685,14 @@ package body Sem_Ch10 is -- Skip analyzing with clause if no unit; this happens for a with -- that references a non-existent unit. - if Present (Library_Unit (Item)) then + if Present (Withed_Lib_Unit (Item)) then Analyze (Item); end if; -- Do version update (skipped for implicit with) if not Is_Implicit_With (Item) then - Version_Update (N, Library_Unit (Item)); + Version_Update (N, Withed_Lib_Unit (Item)); end if; -- Skip pragmas. Configuration pragmas at the start were handled in @@ -1742,7 +1742,7 @@ package body Sem_Ch10 is -- limited with P.Q; -- package P.Q is ... - elsif Unit (Library_Unit (Item)) = Unit (N) then + elsif Unit (Withed_Lib_Unit (Item)) = Unit (N) then Error_Msg_N ("wrong use of limited-with clause", Item); -- Check wrong use of limited-with clause applied to some @@ -1750,8 +1750,9 @@ package body Sem_Ch10 is elsif Is_Child_Spec (Unit (N)) then declare - Lib_U : constant Entity_Id := Unit (Library_Unit (Item)); - P : Node_Id; + Lib_U : constant Entity_Id := + Unit (Withed_Lib_Unit (Item)); + P : Node_Id; begin P := Parent_Spec (Unit (N)); @@ -1787,16 +1788,16 @@ package body Sem_Ch10 is if Item /= It and then Nkind (It) = N_With_Clause and then not Limited_Present (It) - and then Nkind (Unit (Library_Unit (It))) in + and then Nkind (Unit (Withed_Lib_Unit (It))) in N_Package_Declaration | N_Package_Renaming_Declaration then - if Nkind (Unit (Library_Unit (It))) = + if Nkind (Unit (Withed_Lib_Unit (It))) = N_Package_Declaration then Unit_Name := Name (It); else - Unit_Name := Name (Unit (Library_Unit (It))); + Unit_Name := Name (Unit (Withed_Lib_Unit (It))); end if; -- Check if the named package (or some ancestor) @@ -1836,7 +1837,7 @@ package body Sem_Ch10 is -- Skip analyzing with clause if no unit, see above - if Present (Library_Unit (Item)) then + if Present (Withed_Lib_Unit (Item)) then Analyze (Item); end if; @@ -1844,7 +1845,7 @@ package body Sem_Ch10 is -- is a semantic dependency for recompilation purposes. if not Is_Implicit_With (Item) then - Version_Update (N, Library_Unit (Item)); + Version_Update (N, Withed_Lib_Unit (Item)); end if; -- Pragmas and use clauses and with clauses other than limited with's @@ -1972,7 +1973,7 @@ package body Sem_Ch10 is else Set_Corresponding_Stub (Unit (Comp_Unit), N); Analyze_Subunit (Comp_Unit); - Set_Library_Unit (N, Comp_Unit); + Set_Stub_Subunit (N, Comp_Unit); Set_Corresponding_Body (N, Defining_Entity (Unit (Comp_Unit))); end if; @@ -2007,14 +2008,14 @@ package body Sem_Ch10 is -- If the proper body is already linked to the stub node, the stub is -- in a generic unit and just needs analyzing. - if Present (Library_Unit (N)) then - Set_Corresponding_Stub (Unit (Library_Unit (N)), N); + if Present (Stub_Subunit (N)) then + Set_Corresponding_Stub (Unit (Stub_Subunit (N)), N); - -- If the subunit has severe errors, the spec of the enclosing - -- body may not be available, in which case do not try analysis. + -- If the subunit has errors, the spec of the enclosing body might + -- not be available, in which case do not try analysis. if Serious_Errors_Detected > 0 - and then No (Library_Unit (Library_Unit (N))) + and then No (Subunit_Parent (Stub_Subunit (N))) then return; end if; @@ -2026,10 +2027,10 @@ package body Sem_Ch10 is and then In_Extended_Main_Source_Unit (Cunit_Entity (Current_Sem_Unit)) then - SCO_Record_Raw (Get_Cunit_Unit_Number (Library_Unit (N))); + SCO_Record_Raw (Get_Cunit_Unit_Number (Stub_Subunit (N))); end if; - Analyze_Subunit (Library_Unit (N)); + Analyze_Subunit (Stub_Subunit (N)); -- Otherwise we must load the subunit and link to it @@ -2064,7 +2065,7 @@ package body Sem_Ch10 is Set_Corresponding_Stub (Unit (Cunit (Unum)), N); Analyze_Subunit (Cunit (Unum)); - Set_Library_Unit (N, Cunit (Unum)); + Set_Stub_Subunit (N, Cunit (Unum)); end if; end if; @@ -2106,10 +2107,10 @@ package body Sem_Ch10 is -- substitution of subunits, it makes sense to include it in the -- version identification. - if Present (Library_Unit (N)) then - Set_Corresponding_Stub (Unit (Library_Unit (N)), N); - Analyze_Subunit (Library_Unit (N)); - Version_Update (Cunit (Main_Unit), Library_Unit (N)); + if Present (Stub_Subunit (N)) then + Set_Corresponding_Stub (Unit (Stub_Subunit (N)), N); + Analyze_Subunit (Stub_Subunit (N)); + Version_Update (Cunit (Main_Unit), Stub_Subunit (N)); -- Otherwise we must load the subunit and link to it @@ -2163,7 +2164,7 @@ package body Sem_Ch10 is else Set_Corresponding_Stub (Unit (Comp_Unit), N); - Set_Library_Unit (N, Comp_Unit); + Set_Stub_Subunit (N, Comp_Unit); -- We update the version. Although we are not technically -- semantically dependent on the subunit, given our approach @@ -2382,7 +2383,7 @@ package body Sem_Ch10 is and then Limited_Present (Item) and then not Is_Implicit_With (Item) then - Semantics (Library_Unit (Item)); + Semantics (Withed_Lib_Unit (Item)); end if; Next (Item); @@ -2463,10 +2464,10 @@ package body Sem_Ch10 is -- SPARK mode. procedure Analyze_Subunit (N : Node_Id) is - Lib_Unit : constant Node_Id := Library_Unit (N); + Lib_Unit : constant Node_Id := Subunit_Parent (N); Par_Unit : constant Entity_Id := Current_Scope; - Lib_Spec : Node_Id := Library_Unit (Lib_Unit); + Lib_Spec : Node_Id := Other_Comp_Unit (Lib_Unit); Num_Scopes : Nat := 0; Use_Clauses : array (1 .. Scope_Stack.Last) of Node_Id; Enclosing_Child : Entity_Id := Empty; @@ -2606,7 +2607,7 @@ package body Sem_Ch10 is begin if Nkind (Unit (L)) = N_Subunit then - Re_Install_Parents (Library_Unit (L), Scope (Scop)); + Re_Install_Parents (Subunit_Parent (L), Scope (Scop)); end if; Install_Context (L, False); @@ -2739,7 +2740,7 @@ package body Sem_Ch10 is Remove_Context (Lib_Spec); while Nkind (Unit (Lib_Spec)) = N_Subunit loop - Lib_Spec := Library_Unit (Lib_Spec); + Lib_Spec := Subunit_Parent (Lib_Spec); Remove_Scope; Remove_Context (Lib_Spec); end loop; @@ -2750,7 +2751,7 @@ package body Sem_Ch10 is if Nkind (Unit (Lib_Spec)) in N_Package_Body | N_Subprogram_Body then - Remove_Context (Library_Unit (Lib_Spec)); + Remove_Context (Spec_Lib_Unit (Lib_Spec)); end if; end if; @@ -2935,13 +2936,12 @@ package body Sem_Ch10 is -- instantiation appears indirectly elsewhere in the context, it will -- have been analyzed already. - Unit_Kind : constant Node_Kind := - Nkind (Original_Node (Unit (Library_Unit (N)))); + U : constant Node_Id := Unit (Withed_Lib_Unit (N)); + Unit_Kind : constant Node_Kind := Nkind (Original_Node (U)); Nam : constant Node_Id := Name (N); E_Name : Entity_Id; Par_Name : Entity_Id; Pref : Node_Id; - U : constant Node_Id := Unit (Library_Unit (N)); Intunit : Boolean; -- Set True if the unit currently being compiled is an internal unit @@ -3034,7 +3034,8 @@ package body Sem_Ch10 is -- legality of subsequent (also useless) use clauses depend on the -- presence of the with clause. - if Library_Unit (N) = Library_Unit (Cunit (Current_Sem_Unit)) then + if Withed_Lib_Unit (N) = Spec_Or_Body_Lib_Unit (Cunit (Current_Sem_Unit)) + then Set_Is_Implicit_With (N); -- Self-referential withs are always useless, so warn @@ -3068,7 +3069,7 @@ package body Sem_Ch10 is -- Normal (non-self-referential) case else - Semantics (Library_Unit (N)); + Semantics (Withed_Lib_Unit (N)); end if; Intunit := Is_Internal_Unit (Current_Sem_Unit); @@ -3164,8 +3165,8 @@ package body Sem_Ch10 is -- visibility purposes we need the entity of its spec. elsif (Unit_Kind = N_Package_Instantiation - or else Nkind (Original_Node (Unit (Library_Unit (N)))) = - N_Package_Instantiation) + or else Nkind (Original_Node (Unit (Withed_Lib_Unit (N)))) = + N_Package_Instantiation) and then Nkind (U) = N_Package_Body then E_Name := Corresponding_Spec (U); @@ -3203,7 +3204,7 @@ package body Sem_Ch10 is elsif Unit_Kind = N_Subprogram_Body and then Nkind (Name (N)) = N_Selected_Component - and then not Acts_As_Spec (Library_Unit (N)) + and then not Acts_As_Spec (Withed_Lib_Unit (N)) then -- For a child unit that has no spec, one has been created and -- analyzed. The entity required is that of the spec. @@ -3228,10 +3229,11 @@ package body Sem_Ch10 is -- with_clause for the child unit (e.g. in separate subunits). if Unit_Kind = N_Subprogram_Declaration - and then Analyzed (Library_Unit (N)) - and then not Comes_From_Source (Library_Unit (N)) + and then Analyzed (Withed_Lib_Unit (N)) + and then not Comes_From_Source (Withed_Lib_Unit (N)) then - Set_Library_Unit (N, + Set_Library_Unit (N, Empty); -- overwritten by Set_Withed_Lib_Unit + Set_Withed_Lib_Unit (N, Cunit (Get_Source_Unit (Corresponding_Body (U)))); end if; end if; @@ -3349,7 +3351,7 @@ package body Sem_Ch10 is -- Propagate Fatal_Error setting from with'ed unit to current unit - case Fatal_Error (Get_Source_Unit (Library_Unit (N))) is + case Fatal_Error (Get_Source_Unit (Withed_Lib_Unit (N))) is -- Nothing to do if with'ed unit had no error @@ -3386,7 +3388,7 @@ package body Sem_Ch10 is begin if Nkind (Lib_Unit) in N_Package_Body | N_Subprogram_Body then - Curr_Unit := Defining_Entity (Unit (Library_Unit (N))); + Curr_Unit := Defining_Entity (Unit (Spec_Lib_Unit (N))); Par_Lib := Curr_Unit; elsif Nkind (Lib_Unit) = N_Subunit then @@ -3394,8 +3396,8 @@ package body Sem_Ch10 is -- The parent is itself a body. The parent entity is to be found in -- the corresponding spec. - Sub_Parent := Library_Unit (N); - Curr_Unit := Defining_Entity (Unit (Library_Unit (Sub_Parent))); + Sub_Parent := Subunit_Parent (N); + Curr_Unit := Defining_Entity (Unit (Other_Comp_Unit (Sub_Parent))); -- If the parent itself is a subunit, Curr_Unit is the entity of the -- enclosing body, retrieve the spec entity which is the proper @@ -3675,7 +3677,7 @@ package body Sem_Ch10 is begin Set_Corresponding_Spec (Withn, Ent); Set_Is_Implicit_With (Withn); - Set_Library_Unit (Withn, Parent (Unit_Declaration_Node (Ent))); + Set_Withed_Lib_Unit (Withn, Parent (Unit_Declaration_Node (Ent))); Set_Parent_With (Withn); -- If the unit is a [generic] package or subprogram declaration @@ -3900,7 +3902,7 @@ package body Sem_Ch10 is begin Set_Corresponding_Spec (Withn, P_Name); Set_Is_Implicit_With (Withn); - Set_Library_Unit (Withn, P); + Set_Withed_Lib_Unit (Withn, P); Set_Parent_With (Withn); -- Node is placed at the beginning of the context items, so that @@ -4041,18 +4043,19 @@ package body Sem_Ch10 is elsif Nkind (Decl_Node) = N_Subprogram_Body and then not Acts_As_Spec (Parent (Decl_Node)) - and then Is_Child_Spec (Unit (Library_Unit (Parent (Decl_Node)))) + and then + Is_Child_Spec (Unit (Subunit_Parent (Parent (Decl_Node)))) then Implicit_With_On_Parent - (Unit (Library_Unit (Parent (Decl_Node))), N); + (Unit (Subunit_Parent (Parent (Decl_Node))), N); end if; -- Check license conditions unless this is a dummy unit - if Sloc (Library_Unit (Item)) /= No_Location then + if Sloc (Withed_Lib_Unit (Item)) /= No_Location then License_Check : declare Withu : constant Unit_Number_Type := - Get_Source_Unit (Library_Unit (Item)); + Get_Source_Unit (Withed_Lib_Unit (Item)); Withl : constant License_Type := License (Source_Index (Withu)); Unitl : constant License_Type := @@ -4147,18 +4150,18 @@ package body Sem_Ch10 is or else (Nkind (Lib_Unit) = N_Subprogram_Body and then not Acts_As_Spec (N)) then - Install_Context (Library_Unit (N), Chain); + Install_Context (Spec_Lib_Unit (N), Chain); -- Only install private with-clauses of a spec that comes from -- source, excluding specs created for a subprogram body that is -- a child unit. - if Comes_From_Source (Library_Unit (N)) then + if Comes_From_Source (Spec_Lib_Unit (N)) then Install_Private_With_Clauses - (Defining_Entity (Unit (Library_Unit (N)))); + (Defining_Entity (Unit (Spec_Lib_Unit (N)))); end if; - if Is_Child_Spec (Unit (Library_Unit (N))) then + if Is_Child_Spec (Unit (Spec_Lib_Unit (N))) then -- If the unit is the body of a public child unit, the private -- declarations of the parent must be made visible. If the child @@ -4174,7 +4177,7 @@ package body Sem_Ch10 is P_Name : Entity_Id; begin - Lib_Spec := Unit (Library_Unit (N)); + Lib_Spec := Unit (Spec_Lib_Unit (N)); while Is_Child_Spec (Lib_Spec) loop P := Unit (Parent_Spec (Lib_Spec)); P_Name := Defining_Entity (P); @@ -4194,7 +4197,7 @@ package body Sem_Ch10 is -- For a package body, children in context are immediately visible - Install_Siblings (Defining_Entity (Unit (Library_Unit (N))), N); + Install_Siblings (Defining_Entity (Unit (Spec_Lib_Unit (N))), N); end if; if Nkind (Lib_Unit) in N_Generic_Package_Declaration @@ -4269,7 +4272,7 @@ package body Sem_Ch10 is -- Protect the frontend against previous critical errors - case Nkind (Unit (Library_Unit (W))) is + case Nkind (Unit (Withed_Lib_Unit (W))) is when N_Generic_Package_Declaration | N_Generic_Subprogram_Declaration | N_Package_Declaration @@ -4283,7 +4286,8 @@ package body Sem_Ch10 is -- Check "use + renamings" - WEnt := Defining_Unit_Name (Specification (Unit (Library_Unit (W)))); + WEnt := + Defining_Unit_Name (Specification (Unit (Withed_Lib_Unit (W)))); Spec := Specification (Unit (P)); Item := First (Visible_Declarations (Spec)); @@ -4347,13 +4351,13 @@ package body Sem_Ch10 is begin -- Compilation unit of the parent of the withed library unit - Child_Parent := Library_Unit (Item); + Child_Parent := Withed_Lib_Unit (Item); -- If the child unit is a public child, then locate its nearest -- private ancestor, if any, then Child_Parent will then be set to -- the parent of that ancestor. - if not Private_Present (Library_Unit (Item)) then + if not Private_Present (Withed_Lib_Unit (Item)) then while Present (Child_Parent) and then not Private_Present (Child_Parent) loop @@ -4433,12 +4437,13 @@ package body Sem_Ch10 is begin -- A limited with_clause cannot appear in the same context_clause - -- as a nonlimited with_clause which mentions the same library. + -- as a nonlimited with_clause which mentions the same library + -- unit. Item := First (Context_Items (Comp_Unit)); while Present (Item) loop if Nkind (Item) = N_With_Clause - and then Library_Unit (Item) = Library_Unit (W) + and then Withed_Lib_Unit (Item) = Withed_Lib_Unit (W) then return True; end if; @@ -4488,7 +4493,7 @@ package body Sem_Ch10 is return; end if; - Set_Library_Unit (Withn, Cunit (Unum)); + Set_Withed_Lib_Unit (Withn, Cunit (Unum)); Set_Corresponding_Spec (Withn, Specification (Unit (Cunit (Unum)))); @@ -4542,11 +4547,11 @@ package body Sem_Ch10 is -- the private clause is installed before analyzing the private -- part of the current unit. - if Library_Unit (Item) /= Cunit (Current_Sem_Unit) + if Withed_Lib_Unit (Item) /= Cunit (Current_Sem_Unit) and then not Limited_View_Installed (Item) and then not Is_Ancestor_Unit - (Library_Unit (Item), Cunit (Current_Sem_Unit)) + (Withed_Lib_Unit (Item), Cunit (Current_Sem_Unit)) then if not Private_Present (Item) or else Private_Present (N) @@ -4785,7 +4790,7 @@ package body Sem_Ch10 is if Limited_Present (Item) then if not Limited_View_Installed (Item) and then - not Is_Ancestor_Unit (Library_Unit (Item), + not Is_Ancestor_Unit (Withed_Lib_Unit (Item), Cunit (Current_Sem_Unit)) then Install_Limited_With_Clause (Item); @@ -4960,7 +4965,7 @@ package body Sem_Ch10 is --------------------------------- procedure Install_Limited_With_Clause (N : Node_Id) is - P_Unit : constant Entity_Id := Unit (Library_Unit (N)); + P_Unit : constant Entity_Id := Unit (Withed_Lib_Unit (N)); E : Entity_Id; P : Entity_Id; Is_Child_Package : Boolean := False; @@ -5100,7 +5105,7 @@ package body Sem_Ch10 is and then Nkind (Decl) = N_Pragma loop if Get_Pragma_Id (Decl) = Pragma_Elaborate_Body then - Set_Body_Required (Library_Unit (N)); + Set_Body_Required (Withed_Lib_Unit (N)); return; end if; @@ -5196,7 +5201,7 @@ package body Sem_Ch10 is -- If no completion, this is a TAT, and a body is needed if No (Decl) then - Set_Body_Required (Library_Unit (N)); + Set_Body_Required (Withed_Lib_Unit (N)); return; end if; @@ -5228,7 +5233,7 @@ package body Sem_Ch10 is null; else - Set_Body_Required (Library_Unit (N)); + Set_Body_Required (Withed_Lib_Unit (N)); return; end if; @@ -5452,7 +5457,7 @@ package body Sem_Ch10 is if Is_Child_Unit (Defining_Entity - (Unit (Library_Unit (Cunit (Current_Sem_Unit))))) + (Unit (Spec_Lib_Unit (Cunit (Current_Sem_Unit))))) then return; end if; @@ -5822,7 +5827,7 @@ package body Sem_Ch10 is Set_Is_Visible_Lib_Unit (Related_Instance - (Defining_Entity (Unit (Library_Unit (With_Clause))))); + (Defining_Entity (Unit (Withed_Lib_Unit (With_Clause))))); end if; -- The parent unit may have been installed already, and may have @@ -5973,7 +5978,7 @@ package body Sem_Ch10 is E2 : Entity_Id; begin if Nkind (Unit (U2)) in N_Package_Body | N_Subprogram_Body then - E2 := Defining_Entity (Unit (Library_Unit (U2))); + E2 := Defining_Entity (Unit (Spec_Lib_Unit (U2))); return Is_Ancestor_Package (E1, E2); else return False; @@ -6051,17 +6056,17 @@ package body Sem_Ch10 is while Present (Item) loop if Nkind (Item) = N_With_Clause and then not Limited_Present (Item) - and then Nkind (Unit (Library_Unit (Item))) = + and then Nkind (Unit (Withed_Lib_Unit (Item))) = N_Package_Declaration then Decl := First (Visible_Declarations - (Specification (Unit (Library_Unit (Item))))); + (Specification (Unit (Withed_Lib_Unit (Item))))); while Present (Decl) loop if Nkind (Decl) = N_Package_Renaming_Declaration and then Entity (Name (Decl)) = P and then not Is_Limited_Withed_Unit - (Lib_Unit => Library_Unit (Item), + (Lib_Unit => Withed_Lib_Unit (Item), Pkg_Ent => Entity (Name (Decl))) then -- Generate the error message only if the current unit @@ -6097,11 +6102,10 @@ package body Sem_Ch10 is -- If it is a body not acting as spec, follow pointer to the -- corresponding spec, otherwise follow pointer to parent spec. - if Present (Library_Unit (Aux_Unit)) - and then Nkind (Unit (Aux_Unit)) in - N_Package_Body | N_Subprogram_Body + if Nkind (Unit (Aux_Unit)) in N_Package_Body | N_Subprogram_Body + and then Present (Spec_Lib_Unit (Aux_Unit)) then - if Aux_Unit = Library_Unit (Aux_Unit) then + if Aux_Unit = Spec_Lib_Unit (Aux_Unit) then -- Aux_Unit is a body that acts as a spec. Clause has -- already been flagged as illegal. @@ -6109,7 +6113,7 @@ package body Sem_Ch10 is return False; else - Aux_Unit := Library_Unit (Aux_Unit); + Aux_Unit := Spec_Lib_Unit (Aux_Unit); end if; else @@ -6186,7 +6190,7 @@ package body Sem_Ch10 is procedure Build_Limited_Views (N : Node_Id) is Unum : constant Unit_Number_Type := - Get_Source_Unit (Library_Unit (N)); + Get_Source_Unit (Withed_Lib_Unit (N)); Is_Analyzed : constant Boolean := Analyzed (Cunit (Unum)); Shadow_Pack : Entity_Id; @@ -6647,7 +6651,7 @@ package body Sem_Ch10 is -- declaration, not a subprogram declaration, generic declaration, -- generic instantiation, or package renaming declaration. - case Nkind (Unit (Library_Unit (N))) is + case Nkind (Unit (Withed_Lib_Unit (N))) is when N_Package_Declaration => null; @@ -6702,7 +6706,7 @@ package body Sem_Ch10 is -- Check if the chain is already built - Spec := Specification (Unit (Library_Unit (N))); + Spec := Specification (Unit (Withed_Lib_Unit (N))); if Limited_View_Installed (Spec) then return; @@ -6766,7 +6770,7 @@ package body Sem_Ch10 is while Present (CI) loop if Nkind (CI) = N_With_Clause and then not - No_Elab_Code_All (Get_Source_Unit (Library_Unit (CI))) + No_Elab_Code_All (Get_Source_Unit (Withed_Lib_Unit (CI))) -- In GNATprove mode, some runtime units are implicitly -- loaded to make their entities available for analysis. In @@ -6947,7 +6951,7 @@ package body Sem_Ch10 is and then not Is_Implicit_With (Item) then Set_Is_Immediately_Visible - (Defining_Entity (Unit (Library_Unit (Item))), False); + (Defining_Entity (Unit (Withed_Lib_Unit (Item))), False); end if; end if; @@ -6994,7 +6998,7 @@ package body Sem_Ch10 is -------------------------------- procedure Remove_Limited_With_Clause (N : Node_Id) is - Pack_Decl : constant Entity_Id := Unit (Library_Unit (N)); + Pack_Decl : constant Entity_Id := Unit (Withed_Lib_Unit (N)); begin pragma Assert (Limited_View_Installed (N)); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3ef4e69..f0c55af 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5786,7 +5786,7 @@ package body Sem_Ch12 is end if; if Ekind (Curr_Unit) = E_Package_Body then - Remove_Context (Library_Unit (Curr_Comp)); + Remove_Context (Spec_Lib_Unit (Curr_Comp)); end if; end if; @@ -6992,10 +6992,10 @@ package body Sem_Ch12 is Body_Cunit := Parent (N); - -- The two compilation unit nodes are linked by the Library_Unit field + -- Set spec/body links for the two compilation units - Set_Library_Unit (Decl_Cunit, Body_Cunit); - Set_Library_Unit (Body_Cunit, Decl_Cunit); + Set_Body_Lib_Unit (Decl_Cunit, Body_Cunit); + Set_Spec_Lib_Unit (Body_Cunit, Decl_Cunit); -- Preserve the private nature of the package if needed @@ -9175,11 +9175,11 @@ package body Sem_Ch12 is -- stub in the original generic unit with the subunit, in order -- to preserve non-local references within. - -- Only the proper body needs to be copied. Library_Unit and - -- context clause are simply inherited by the generic copy. - -- Note that the copy (which may be recursive if there are - -- nested subunits) must be done first, before attaching it to - -- the enclosing generic. + -- Only the proper body needs to be copied. The context clause + -- and Spec_Or_Body_Lib_Unit are simply inherited by the + -- generic copy. Note that the copy (which may be recursive + -- if there are nested subunits) must be done first, before + -- attaching it to the enclosing generic. New_Body := Copy_Generic_Node @@ -9198,7 +9198,7 @@ package body Sem_Ch12 is -- copy, which does not have stubs any longer. Set_Proper_Body (Unit (Subunit), New_Body); - Set_Library_Unit (New_N, Subunit); + Set_Stub_Subunit (New_N, Subunit); Inherit_Context (Unit (Subunit), N); end; @@ -9213,17 +9213,17 @@ package body Sem_Ch12 is <<Subunit_Not_Found>> null; - -- If the node is a compilation unit, it is the subunit of a stub, which - -- has been loaded already (see code below). In this case, the library - -- unit field of N points to the parent unit (which is a compilation - -- unit) and need not (and cannot) be copied. + -- If the node is a compilation unit, it is the subunit of a stub that + -- has already been loaded. The parent unit is a compilation unit and + -- need not (and cannot) be copied. - -- When the proper body of the stub is analyzed, the library_unit link - -- is used to establish the proper context (see sem_ch10). + -- When the proper body of the stub is analyzed, the Subunit_Parent + -- field is used to establish the proper context (see Sem_Ch10). -- The other fields of a compilation unit are copied as usual elsif Nkind (N) = N_Compilation_Unit then + pragma Assert (Unit (N) in N_Subunit_Id); -- This code can only be executed when not instantiating, because in -- the copy made for an instantiation, the compilation unit node has @@ -10155,7 +10155,7 @@ package body Sem_Ch12 is if Nkind (B) = N_Package_Body then Id := Corresponding_Spec (B); else pragma Assert (Nkind (B) = N_Package_Body_Stub); - Id := Corresponding_Spec (Proper_Body (Unit (Library_Unit (B)))); + Id := Corresponding_Spec (Proper_Body (Unit (Stub_Subunit (B)))); end if; Ensure_Freeze_Node (Id); @@ -10265,7 +10265,7 @@ package body Sem_Ch12 is begin if Nkind (Enc_N) = N_Package_Body_Stub then - Enclosing_Body := Proper_Body (Unit (Library_Unit (Enc_N))); + Enclosing_Body := Proper_Body (Unit (Stub_Subunit (Enc_N))); else Enclosing_Body := Enc_N; end if; @@ -10648,7 +10648,7 @@ package body Sem_Ch12 is Item := First (Context_Items (Parent (Gen_Decl))); while Present (Item) loop if Nkind (Item) = N_With_Clause then - Lib_Unit := Library_Unit (Item); + Lib_Unit := Withed_Lib_Unit (Item); -- Take care to prevent direct cyclic with's @@ -10660,7 +10660,7 @@ package body Sem_Ch12 is OK := True; while Present (Clause) loop if Nkind (Clause) = N_With_Clause - and then Library_Unit (Clause) = Lib_Unit + and then Withed_Lib_Unit (Clause) = Lib_Unit then OK := False; exit; @@ -10892,7 +10892,7 @@ package body Sem_Ch12 is not In_Same_Source_Unit (Generic_Parent (Par_Inst), Inst) then while Present (Decl) loop - if ((Nkind (Decl) in N_Unit_Body + if ((Nkind (Decl) in N_Lib_Unit_Body or else Nkind (Decl) in N_Body_Stub) and then Comes_From_Source (Decl)) @@ -15360,10 +15360,10 @@ package body Sem_Ch12 is return Current_Unit = Cunit (Main_Unit) - or else Current_Unit = Library_Unit (Cunit (Main_Unit)) + or else Current_Unit = Other_Comp_Unit (Cunit (Main_Unit)) or else (Present (Current_Unit) - and then Present (Library_Unit (Current_Unit)) - and then Is_In_Main_Unit (Library_Unit (Current_Unit))); + and then Present (Other_Comp_Unit (Current_Unit)) + and then Is_In_Main_Unit (Other_Comp_Unit (Current_Unit))); end Is_In_Main_Unit; ---------------------------- diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 07a88fe..ff64744 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1406,7 +1406,7 @@ package body Sem_Ch7 is begin if Id = Cunit_Entity (Main_Unit) - or else Parent (Decl) = Library_Unit (Cunit (Main_Unit)) + or else Parent (Decl) = Other_Comp_Unit (Cunit (Main_Unit)) then Generate_Reference (Id, Scope (Id), 'k', False); @@ -1422,7 +1422,7 @@ package body Sem_Ch7 is begin if Nkind (Main_Spec) = N_Package_Body then - Main_Spec := Unit (Library_Unit (Cunit (Main_Unit))); + Main_Spec := Unit (Other_Comp_Unit (Cunit (Main_Unit))); end if; U := Parent_Spec (Main_Spec); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0c25c95..2007db3 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -9998,7 +9998,8 @@ package body Sem_Ch8 is or else (Nkind (The_Unit) = N_Subprogram_Body and then not Acts_As_Spec (Cunit (Current_Sem_Unit)))) then - With_Sys := Find_System (Library_Unit (Cunit (Current_Sem_Unit))); + With_Sys := + Find_System (Spec_Or_Body_Lib_Unit (Cunit (Current_Sem_Unit))); end if; if No (With_Sys) and then Present (N) then @@ -10055,7 +10056,7 @@ package body Sem_Ch8 is Set_Corresponding_Spec (Withn, System_Aux_Id); Set_First_Name (Withn); Set_Is_Implicit_With (Withn); - Set_Library_Unit (Withn, Cunit (Unum)); + Set_Withed_Lib_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 23cbe1a..a0431a2 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -8461,9 +8461,9 @@ package body Sem_Elab is Set_Context_Items (Main_Cunit, Items); end if; - -- Locate the with clause for the unit. Note that there may not be a - -- clause if the unit is visible through a subunit-body, body-spec, - -- or spec-parent relationship. + -- Locate the with clause for the unit. Note that there might not be + -- a with clause if the unit is visible through a subunit-body, + -- body-spec, or spec-parent relationship. Clause := Find_With_Clause @@ -8475,16 +8475,16 @@ package body Sem_Elab is -- Note that adding implicit with clauses is safe because analysis, -- resolution, and expansion have already taken place and it is not - -- possible to interfere with visibility. + -- possible to interfere with visibility. Note that this implicit + -- with clause can point at (for example) a package body, which + -- is not the case for normal with clauses. if No (Clause) then Clause := Make_With_Clause (Loc, Name => New_Occurrence_Of (Unit_Id, Loc)); - Set_Is_Implicit_With (Clause); - Set_Library_Unit (Clause, Unit_Cunit); - + Set_Withed_Lib_Unit (Clause, Unit_Cunit); Append_To (Items, Clause); end if; @@ -9887,7 +9887,7 @@ package body Sem_Elab is elsif Nkind (Item) = N_Package_Body_Stub and then Chars (Defining_Entity (Item)) = Spec_Nam then - Lib_Unit := Library_Unit (Item); + Lib_Unit := Stub_Subunit (Item); -- The corresponding subunit was previously loaded @@ -16374,6 +16374,8 @@ package body Sem_Elab is -- This procedure is called when the elaborate indication must be -- applied to a unit not in the context of the referencing unit. The -- unit gets added to the context as an implicit with. + -- Note that we can be with-ing (for example) a package body, which + -- is not the case for normal with clauses. function In_Withs_Of (UEs : Entity_Id) return Boolean; -- UEs is the spec entity of a unit. If the unit to be marked is @@ -16394,7 +16396,7 @@ package body Sem_Elab is begin Set_Is_Implicit_With (CW); - Set_Library_Unit (CW, Library_Unit (Itm)); + Set_Withed_Lib_Unit (CW, Withed_Lib_Unit (Itm)); -- Set elaborate all desirable on copy and then append the copy to -- the list of body with's and we are done. @@ -16417,7 +16419,7 @@ package body Sem_Elab is while Present (Itm) loop if Nkind (Itm) = N_With_Clause then Ent := - Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + Cunit_Entity (Get_Cunit_Unit_Number (Withed_Lib_Unit (Itm))); if U = Ent then return True; @@ -16465,7 +16467,8 @@ package body Sem_Elab is Itm := First (CI); while Present (Itm) loop if Nkind (Itm) = N_With_Clause then - Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm))); + Ent := + Cunit_Entity (Get_Cunit_Unit_Number (Withed_Lib_Unit (Itm))); -- If we find it, then mark elaborate all desirable and return @@ -19055,8 +19058,8 @@ package body Sem_Elab is elsif Nkind (Nod) = N_Package_Body_Stub and then Chars (Defining_Identifier (Nod)) = Chars (E) then - if Present (Library_Unit (Nod)) then - return Unit (Library_Unit (Nod)); + if Present (Stub_Subunit (Nod)) then + return Unit (Stub_Subunit (Nod)); else return Load_Package_Body (Get_Unit_Name (Nod)); @@ -19756,7 +19759,7 @@ package body Sem_Elab is -- in each N_Compilation_Unit node, but that would involve -- rearranging N_Compilation_Unit_Aux to make room. - Helper (Get_Cunit_Unit_Number (Library_Unit (Item))); + Helper (Get_Cunit_Unit_Number (Withed_Lib_Unit (Item))); if Result then return; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index eb11ceb..d877251 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5651,8 +5651,7 @@ package body Sem_Prag is then Set_Has_Pragma_Unreferenced (Cunit_Entity - (Get_Source_Unit - (Library_Unit (Citem)))); + (Get_Source_Unit (Withed_Lib_Unit (Citem)))); Set_Elab_Unit_Name (Arg_Expr, Name (Citem)); exit; end if; @@ -8308,21 +8307,21 @@ package body Sem_Prag is Decl : Node_Id; Err : Boolean; - function Same_Convention (Decl : Node_Id) return Boolean; + function Matching_Convention (Decl : Node_Id) return Boolean; -- Decl is a pragma node. This function returns True if this -- pragma has a first argument that is an identifier with a -- Chars field corresponding to the Convention_Id C. - function Same_Name (Decl : Node_Id) return Boolean; + function Matching_Name (Decl : Node_Id) return Boolean; -- Decl is a pragma node. This function returns True if this -- pragma has a second argument that is an identifier with a -- Chars field that matches the Chars of the current subprogram. - --------------------- - -- Same_Convention -- - --------------------- + ------------------------- + -- Matching_Convention -- + ------------------------- - function Same_Convention (Decl : Node_Id) return Boolean is + function Matching_Convention (Decl : Node_Id) return Boolean is Arg1 : constant Node_Id := First (Pragma_Argument_Associations (Decl)); @@ -8341,13 +8340,13 @@ package body Sem_Prag is end if; return False; - end Same_Convention; + end Matching_Convention; - --------------- - -- Same_Name -- - --------------- + ------------------- + -- Matching_Name -- + ------------------- - function Same_Name (Decl : Node_Id) return Boolean is + function Matching_Name (Decl : Node_Id) return Boolean is Arg1 : constant Node_Id := First (Pragma_Argument_Associations (Decl)); Arg2 : Node_Id; @@ -8374,7 +8373,7 @@ package body Sem_Prag is end; return False; - end Same_Name; + end Matching_Name; -- Start of processing for Diagnose_Multiple_Pragmas @@ -8400,7 +8399,7 @@ package body Sem_Prag is -- Look for pragma with same name as us if Nkind (Decl) = N_Pragma - and then Same_Name (Decl) + and then Matching_Name (Decl) then -- Give error if same as our pragma or Export/Convention @@ -8421,7 +8420,7 @@ package body Sem_Prag is -- they specify the same convention. If so, all OK, -- and set special flags to stop other messages - if Same_Convention (Decl) then + if Matching_Convention (Decl) then Set_Import_Interface_Present (N); Set_Import_Interface_Present (Decl); Err := False; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1a51221..794bded 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7506,7 +7506,7 @@ package body Sem_Util is while Present (Encl_Unit) and then Nkind (Unit (Encl_Unit)) = N_Subunit loop - Encl_Unit := Library_Unit (Encl_Unit); + Encl_Unit := Subunit_Parent (Encl_Unit); end loop; pragma Assert (Nkind (Encl_Unit) = N_Compilation_Unit); @@ -10059,7 +10059,7 @@ package body Sem_Util is function Get_Body_From_Stub (N : Node_Id) return Node_Id is begin - return Proper_Body (Unit (Library_Unit (N))); + return Proper_Body (Unit (Stub_Subunit (N))); end Get_Body_From_Stub; --------------------- @@ -20170,7 +20170,7 @@ package body Sem_Util is return Is_RCI_Pkg_Decl_Cunit (Cunit) or else (Nkind (Unit (Cunit)) = N_Package_Body - and then Is_RCI_Pkg_Decl_Cunit (Library_Unit (Cunit))); + and then Is_RCI_Pkg_Decl_Cunit (Spec_Lib_Unit (Cunit))); end Is_RCI_Pkg_Spec_Or_Body; ----------------------------------------- @@ -27020,13 +27020,13 @@ package body Sem_Util is K2 : constant Node_Kind := Nkind (N2); begin - if (K1 = N_Identifier or else K1 = N_Defining_Identifier) - and then (K2 = N_Identifier or else K2 = N_Defining_Identifier) + if K1 in N_Identifier | N_Defining_Identifier + and then K2 in N_Identifier | N_Defining_Identifier then return Chars (N1) = Chars (N2); - elsif (K1 = N_Selected_Component or else K1 = N_Expanded_Name) - and then (K2 = N_Selected_Component or else K2 = N_Expanded_Name) + elsif K1 in N_Selected_Component | N_Expanded_Name + and then K2 in N_Selected_Component | N_Expanded_Name then return Same_Name (Selector_Name (N1), Selector_Name (N2)) and then Same_Name (Prefix (N1), Prefix (N2)); @@ -29046,7 +29046,7 @@ package body Sem_Util is Clause := First (Context_Items (Comp_Unit)); while Present (Clause) loop if Nkind (Clause) = N_With_Clause then - if Library_Unit (Clause) = U then + if Withed_Lib_Unit (Clause) = U then return True; -- The with_clause may denote a renaming of the unit we are @@ -29084,7 +29084,7 @@ package body Sem_Util is (Nkind (Unit (Curr)) = N_Subprogram_Body and then not Acts_As_Spec (Unit (Curr))) then - if Unit_In_Context (Library_Unit (Curr)) then + if Unit_In_Context (Spec_Lib_Unit (Curr)) then return True; end if; end if; @@ -29092,10 +29092,10 @@ package body Sem_Util is -- If the spec is a child unit, examine the parents if Is_Child_Unit (Curr_Entity) then - if Nkind (Unit (Curr)) in N_Unit_Body then + if Nkind (Unit (Curr)) in N_Lib_Unit_Body then return Unit_In_Parent_Context - (Parent_Spec (Unit (Library_Unit (Curr)))); + (Parent_Spec (Unit (Spec_Lib_Unit (Curr)))); else return Unit_In_Parent_Context (Parent_Spec (Unit (Curr))); end if; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 289d601..2f1d257 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -3065,8 +3065,8 @@ package Sem_Util is -- capture actual value information, but we can capture conditional tests. function Same_Name (N1, N2 : Node_Id) return Boolean; - -- Determine if two (possibly expanded) names are the same name. This is - -- a purely syntactic test, and N1 and N2 need not be analyzed. + -- True if two identifiers or expanded names are the same name. This + -- is a purely syntactic test, and N1 and N2 need not be analyzed. function Same_Object (Node1, Node2 : Node_Id) return Boolean; -- Determine if Node1 and Node2 are known to designate the same object. diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index 23485aa..6660242 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -31,6 +31,145 @@ with Sinput; use Sinput; package body Sinfo.Utils is + function Spec_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id + is + pragma Assert (Unit (N) in N_Lib_Unit_Body_Id); + begin + return Val : constant Opt_N_Compilation_Unit_Id := + Spec_Or_Body_Lib_Unit (N) + do + pragma Assert + (if Present (Val) then + Unit (Val) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id -- only in case of error + or else (N = Val + and then Unit (N) in N_Subprogram_Body_Id + and then Acts_As_Spec (N))); + end return; + end Spec_Lib_Unit; + + procedure Set_Spec_Lib_Unit (N, Val : N_Compilation_Unit_Id) is + pragma Assert (Unit (N) in N_Lib_Unit_Body_Id); + pragma Assert + (Unit (Val) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id -- only in case of error + or else (N = Val + and then Unit (N) in N_Subprogram_Body_Id + and then Acts_As_Spec (N))); + begin + Set_Library_Unit (N, Val); + end Set_Spec_Lib_Unit; + + function Body_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id + is + pragma Assert + (Unit (N) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id); -- only in case of error + begin + return Val : constant Opt_N_Compilation_Unit_Id := + Spec_Or_Body_Lib_Unit (N) + do + pragma Assert + (if Present (Val) then Unit (Val) in N_Lib_Unit_Body_Id); + end return; + end Body_Lib_Unit; + + procedure Set_Body_Lib_Unit (N, Val : N_Compilation_Unit_Id) is + pragma Assert + (Unit (N) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id); -- only in case of error + pragma Assert (Unit (Val) in N_Lib_Unit_Body_Id); + begin + Set_Library_Unit (N, Val); + end Set_Body_Lib_Unit; + + function Spec_Or_Body_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id + is + pragma Assert + (Unit (N) in + N_Lib_Unit_Declaration_Id | N_Lib_Unit_Body_Id + | N_Lib_Unit_Renaming_Declaration_Id); + begin + return Other_Comp_Unit (N); + end Spec_Or_Body_Lib_Unit; + + function Subunit_Parent + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id + is + pragma Assert (Unit (N) in N_Subunit_Id); + begin + return Val : constant Opt_N_Compilation_Unit_Id := Other_Comp_Unit (N) do + pragma Assert + (if Present (Val) then + Unit (Val) in N_Lib_Unit_Body_Id | N_Subunit_Id); + end return; + end Subunit_Parent; + + procedure Set_Subunit_Parent (N, Val : N_Compilation_Unit_Id) is + pragma Assert (Unit (N) in N_Subunit_Id); + pragma Assert (Unit (Val) in N_Lib_Unit_Body_Id | N_Subunit_Id); + begin + Set_Library_Unit (N, Val); + end Set_Subunit_Parent; + + function Other_Comp_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id + is + pragma Assert (N in N_Compilation_Unit_Id); + Val : constant Opt_N_Compilation_Unit_Id := Library_Unit (N); + begin + if Unit (N) in N_Subunit_Id then + pragma Assert + (if Present (Val) then + Unit (Val) in N_Lib_Unit_Body_Id | N_Subunit_Id); + end if; + + return Library_Unit (N); + end Other_Comp_Unit; + + function Stub_Subunit + (N : N_Body_Stub_Id) return Opt_N_Compilation_Unit_Id is + begin + return Val : constant Opt_N_Compilation_Unit_Id := Library_Unit (N) do + pragma Assert (if Present (Val) then Unit (Val) in N_Subunit_Id); + end return; + end Stub_Subunit; + + procedure Set_Stub_Subunit + (N : N_Body_Stub_Id; Val : N_Compilation_Unit_Id) + is + pragma Assert (Unit (Val) in N_Subunit_Id); + begin + Set_Library_Unit (N, Val); + end Set_Stub_Subunit; + + function Withed_Lib_Unit + (N : N_With_Clause_Id) return Opt_N_Compilation_Unit_Id is + begin + return Val : constant Opt_N_Compilation_Unit_Id := Library_Unit (N) do + pragma Assert + (if Present (Val) then + Unit (Val) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id + | N_Package_Body_Id | N_Subprogram_Body_Id + | N_Null_Statement_Id); -- for ignored ghost code + end return; + end Withed_Lib_Unit; + + procedure Set_Withed_Lib_Unit + (N : N_With_Clause_Id; Val : N_Compilation_Unit_Id) + is + pragma Assert + (Unit (Val) in N_Lib_Unit_Declaration_Id + | N_Lib_Unit_Renaming_Declaration_Id + | N_Package_Body_Id | N_Subprogram_Body_Id); + begin + Set_Library_Unit (N, Val); + end Set_Withed_Lib_Unit; + --------------- -- Debugging -- --------------- diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads index 9acb620..ebb9699 100644 --- a/gcc/ada/sinfo-utils.ads +++ b/gcc/ada/sinfo-utils.ads @@ -27,6 +27,65 @@ with Sinfo.Nodes; use Sinfo.Nodes; package Sinfo.Utils is + -- We would like to get rid of the Library_Unit field, and replace it with + -- Other_Comp_Unit (on N_Compilation_Unit), Withed_Lib_Unit (on + -- N_With_Clause), and Subunit (on N_Body_Stub). Or we could split + -- Other_Comp_Unit into Spec_Lib_Unit, Body_Lib_Unit, Subunit_Parent. + -- However, gnat-llvm, codepeer, and spark are still using Library_Unit. + -- Therefore, we use the wrappers below. + -- + -- The call site should always know whether it has an N_Compilation_Unit, + -- N_Body_Stub, or N_With_Clause. In the N_Compilation_Unit case, it should + -- also know whether it's looking for the spec of a body, the body of a + -- spec, or the parent of a subunit. Spec_Or_Body_Lib_Unit and + -- Other_Comp_Unit should be avoided when possible; these are for the + -- N_Compilation_Unit cases where the call site does NOT know what it's + -- looking for. + + function Spec_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id; + procedure Set_Spec_Lib_Unit (N, Val : N_Compilation_Unit_Id); + -- The spec compilation unit of a body compilation unit. + -- It can be an acts-as-spec subprogram body; in that case + -- Spec_Lib_Unit points to itself. + + function Body_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id; + procedure Set_Body_Lib_Unit (N, Val : N_Compilation_Unit_Id); + -- The body compilation unit of a spec compilation unit. + -- Empty if not present. + + function Spec_Or_Body_Lib_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id; + -- Same as Spec_Lib_Unit or Body_Lib_Unit, depending on whether + -- N is a body or spec. Used when we know N is a library unit + -- (not a subunit), but we don't know whether it's the spec + -- or the body. + + function Subunit_Parent + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id; + procedure Set_Subunit_Parent (N, Val : N_Compilation_Unit_Id); + -- The parent body of a subunit + + function Other_Comp_Unit + (N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id; + -- Same as Spec_Lib_Unit, Body_Lib_Unit, or Subunit_Parent, + -- as appropriate. Used when we don't know whether N is a + -- a library unit spec, library unit body, or subunit. + + function Stub_Subunit (N : N_Body_Stub_Id) return Opt_N_Compilation_Unit_Id; + procedure Set_Stub_Subunit + (N : N_Body_Stub_Id; Val : N_Compilation_Unit_Id); + -- Subunit corresponding to a stub + + function Withed_Lib_Unit + (N : N_With_Clause_Id) return Opt_N_Compilation_Unit_Id; + procedure Set_Withed_Lib_Unit + (N : N_With_Clause_Id; Val : N_Compilation_Unit_Id); + -- The compilation unit that a with clause refers to. + -- Note that the Sem_Elab creates with clauses that point to bodies + -- (including non-Acts_As_Spec bodies). + ------------------------------- -- Parent-related operations -- ------------------------------- @@ -54,9 +113,9 @@ package Sinfo.Utils is -- Miscellaneous Tree Access Subprograms -- ------------------------------------------- - function First_Real_Statement -- ???? + function First_Real_Statement -- ??? (Ignored : N_Handled_Sequence_Of_Statements_Id) return Node_Id is (Empty); - -- The First_Real_Statement field is going away, but it is referenced in + -- The First_Real_Statement field has been removed, but it is referenced in -- codepeer and gnat-llvm. This is a temporary version, always returning -- Empty, to ease the transition. diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 8b4c2e3..47fd73a 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1923,34 +1923,18 @@ package Sinfo is -- handler. -- Library_Unit - -- In a stub node, Library_Unit points to the compilation unit node of - -- the corresponding subunit. + -- Direct use of this field should be avoided; use the wrappers in + -- Sinfo.Utils instead. -- - -- In a with clause node, Library_Unit points to the spec of the with'ed - -- unit. + -- This field is used to store the following: -- - -- In a compilation unit node, the usage depends on the unit type: + -- In N_Compilation_Unit: Spec_Lib_Unit, Body_Lib_Unit, Subunit_Parent. -- - -- For a library unit body, Library_Unit points to the compilation unit - -- node of the corresponding spec, unless it's a subprogram body with - -- Acts_As_Spec set, in which case it points to itself. + -- In N_Body_Stub: Stub_Subunit. -- - -- For a spec, Library_Unit points to the compilation unit node of the - -- corresponding body, if present. The body will be present if the spec - -- is or contains generics that we needed to instantiate. Similarly, the - -- body will be present if we needed it for inlining purposes. Thus, if - -- we have a spec/body pair, both of which are present, they point to - -- each other via Library_Unit. + -- In N_With_Clause: Withed_Lib_Unit -- - -- For a subunit, Library_Unit points to the compilation unit node of - -- the parent body. - -- ??? not (always) true, in (at least some, maybe all?) cases it points - -- to the corresponding spec for the parent body. - -- - -- Note that this field is not used to hold the parent pointer for child - -- unit (which might in any case need to use it for some other purpose as - -- described above). Instead for a child unit, implicit with's are - -- generated for all parents. + -- See Sinfo.Utils for details. -- Local_Raise_Statements -- This field is present in exception handler nodes. It is set to @@ -6553,7 +6537,7 @@ package Sinfo is -- | CONTEXT_CLAUSE SUBUNIT -- The N_Compilation_Unit node itself represents the above syntax. - -- However, there are two additional items not reflected in the above + -- However, there are additional items not reflected in the above -- syntax. First we have the global declarations that are added by the -- code generator. These are outer level declarations (so they cannot -- be represented as being inside the units). An example is the wrapper @@ -6566,19 +6550,15 @@ package Sinfo is -- of elaboration of the library unit (notably the statement that sets -- the Boolean flag indicating that elaboration is complete). - -- The third item not reflected in the syntax is pragmas that appear - -- after the compilation unit. As always pragmas are a problem since - -- they are not part of the formal syntax, but can be stuck into the - -- source following a set of ad hoc rules, and we have to find an ad - -- hoc way of sticking them into the tree. For pragmas that appear - -- before the library unit, we just consider them to be part of the - -- context clause, and pragmas can appear in the Context_Items list - -- of the compilation unit. However, pragmas can also appear after - -- the library item. + -- Pragmas that appear after the compilation unit are not reflected + -- in the syntax. (Pragmas that appear before the library unit, are + -- considered part of the context clause. Pragmas can also appear in + -- the Context_Items list of the compilation unit.) - -- To deal with all these problems, we create an auxiliary node for - -- a compilation unit, referenced from the N_Compilation_Unit node, - -- that contains these items. + -- ???For historical reasons, the above information is stored in a + -- separate N_Compilation_Unit_Aux node associated with each + -- N_Compilation_Unit node. This information could be moved into + -- N_Compilation_Unit at this point. -- N_Compilation_Unit -- Sloc points to first token of defining unit name @@ -6595,6 +6575,10 @@ package Sinfo is -- Context_Pending -- Has_No_Elaboration_Code + -- Note: The Unit field can be any of N_Lib_Unit_Declaration, + -- N_Lib_Unit_Body, N_Lib_Unit_Renaming_Declaration, N_Subunit, + -- or (in the case of ignored ghost code) N_Null_Statement. + -- N_Compilation_Unit_Aux -- Sloc is a copy of the Sloc from the N_Compilation_Unit node -- Declarations (set to No_List if no global declarations) @@ -6689,7 +6673,7 @@ package Sinfo is -- Private_Present set if with_clause has private keyword -- Limited_Present set if LIMITED is present -- Next_Implicit_With - -- Library_Unit + -- Library_Unit (i.e. Withed_Lib_Unit) -- Corresponding_Spec -- First_Name (set to True if first name or only one name) -- Last_Name (set to True if last name or only one name) @@ -6748,7 +6732,7 @@ package Sinfo is -- Sloc points to FUNCTION or PROCEDURE -- Specification -- Corresponding_Spec_Of_Stub - -- Library_Unit points to the subunit + -- Library_Unit (i.e. Stub_Subunit) -- Corresponding_Body ------------------------------- @@ -6763,7 +6747,7 @@ package Sinfo is -- Sloc points to PACKAGE -- Defining_Identifier -- Corresponding_Spec_Of_Stub - -- Library_Unit points to the subunit + -- Library_Unit (i.e. Stub_Subunit) -- Corresponding_Body ---------------------------- @@ -6778,7 +6762,7 @@ package Sinfo is -- Sloc points to TASK -- Defining_Identifier -- Corresponding_Spec_Of_Stub - -- Library_Unit points to the subunit + -- Library_Unit (i.e. Stub_Subunit) -- Corresponding_Body -- At_End_Proc (set to Empty if no clean up procedure) @@ -6796,7 +6780,7 @@ package Sinfo is -- Sloc points to PROTECTED -- Defining_Identifier -- Corresponding_Spec_Of_Stub - -- Library_Unit points to the subunit + -- Library_Unit (i.e. Stub_Subunit) -- Corresponding_Body --------------------- |