OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Encoding of with clauses in ALI files 

This patch modifies the encodings of with clauses in ALI files to adhere to the
existing API. The encodigs are as follows:

   * Explicit with clauses are encoded on a 'W' line (same as before).

   * Implicit with clauses for ancestor units are encoded on a 'W' line (same
     as before).

   * Limited_with clauses are encoded on a 'Y' line (same as before).

   * ABE and RTSfind-related with clauses are encoded on a 'Z' line.

------------
-- Source --
------------

--  case_10_func.adb

function Case_10_Func return Boolean is
begin
   return True;
end Case_10_Func;

--  case_10_gen_func.ads

generic
function Case_10_Gen_Func return Boolean;

--  case_10_gen_func.adb

function Case_10_Gen_Func return Boolean is
begin
   return True;
end Case_10_Gen_Func;

--  case_10_tasks.ads

package Case_10_Tasks is
   task type Task_Typ is
   end Task_Typ;
end Case_10_Tasks;

--  case_10_tasks.adb

package body Case_10_Tasks is
   task body Task_Typ is begin null; end Task_Typ;
end Case_10_Tasks;

--  case_10_gen.ads

with Case_10_Func;
with Case_10_Gen_Func;
with Case_10_Tasks;

generic
package Case_10_Gen is
   Val : constant Boolean := Case_10_Func;

   function Inst is new Case_10_Gen_Func;

   Tsk : Case_10_Tasks.Task_Typ;
end Case_10_Gen;

--  case_10.ads

with Case_10_Gen;

package Case_10 is
   package Inst is new Case_10_Gen;
end Case_10;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c case_10.ads
$ grep "W " case_10.ali | sort
$ grep "Z " case_10.ali | sort
W case_10_gen%s		case_10_gen.ads		case_10_gen.ali
Z case_10_func%b	case_10_func.adb	case_10_func.ali
Z case_10_gen_func%s	case_10_gen_func.adb	case_10_gen_func.ali  ED
Z case_10_tasks%s	case_10_tasks.adb	case_10_tasks.ali  AD
Z system.soft_links%s	s-soflin.adb		s-soflin.ali
Z system.tasking%s	s-taskin.adb		s-taskin.ali
Z system.tasking.stages%s  s-tassta.adb		s-tassta.ali

2018-01-11  Hristian Kirtchev  <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.

From-SVN: r256490
This commit is contained in:
Hristian Kirtchev 2018-01-11 08:51:13 +00:00 committed by Pierre-Marie de Rodat
parent 7751927060
commit 94ce49419a
12 changed files with 258 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
gcc/ada/ChangeLog
View File

@ -1,3 +1,42 @@
2018-01-11 Hristian Kirtchev <kirtchev@adacore.com>
* ali.adb: Document the remaining letters available for ALI lines.
(Scan_ALI): A with clause is internal when it is encoded on a 'Z' line.
* ali.ads: Update type With_Record. Field
Implicit_With_From_Instantiation is no longer in use. Add field
Implicit_With.
* csinfo.adb (CSinfo): Remove the setup for attribute
Implicit_With_From_Instantiation.
* lib-writ.adb (Collect_Withs): Correct the logic which marks a unit as
either implicitly or explicitly withed.
(Is_Implicit_With_Clause): New routine.
(Write_ALI): Rename array Implicit_With to Has_Implicit_With to avoid
confusion with the with clause attribute by the same name.
(Write_With_Lines): Update the emission of 'W', 'Y', and 'Z' headers.
* rtsfind.adb (Maybe_Add_With): Code cleanup.
* sem_ch8.adb (Present_System_Aux): Code cleanup.
* sem_ch10.adb (Expand_With_Clause): Mark the with clause as generated
for a parent unit.
(Implicit_With_On_Parent): Mark the with clause as generated for a
parent unit.
* sem_ch12.adb (Inherit_Context): With clauses inherited by an
instantiation are no longer marked as Implicit_With_From_Instantiation
because they are already marked as implicit.
* sem_elab.adb (Ensure_Prior_Elaboration_Static): Remove the kludge
which marks implicit with clauses as related to an instantiation.
* sinfo.adb (Implicit_With_From_Instantiation): Removed.
(Parent_With): New routine.
(Set_Implicit_With_From_Instantiation): Removed.
(Set_Parent_With): New routine.
* sinfo.ads: Update the documentation of attribute Implicit_With.
Remove attribute Implicit_With_From_Instantiation along with
occurrences in nodes. Add attribute Parent_With along with occurrences
in nodes.
(Implicit_With_From_Instantiation): Removed along with pragma Inline.
(Parent_With): New routine along with pragma Inline.
(Set_Implicit_With_From_Instantiation): Removed along with pragma Inline.
(Set_Parent_With): New routine along with pragma Inline.
2018-01-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Find_Enclosing_Scope): Return the unique defining

11
gcc/ada/ali.adb
View File

@ -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

15
gcc/ada/ali.ads
View File

@ -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

3
gcc/ada/csinfo.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -218,7 +218,6 @@ begin
Set (Special, "Has_Dynamic_Range_Check", True);
Set (Special, "Has_Dynamic_Length_Check", True);
Set (Special, "Has_Private_View", True);
Set (Special, "Implicit_With_From_Instantiation", True);
Set (Special, "Is_Controlling_Actual", True);
Set (Special, "Is_Overloaded", True);
Set (Special, "Is_Static_Expression", True);

81
gcc/ada/lib-writ.adb
View File

@ -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;

14
gcc/ada/rtsfind.adb
View File

@ -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;

125
gcc/ada/sem_ch10.adb
View File

@ -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

8
gcc/ada/sem_ch12.adb
View File

@ -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;

11
gcc/ada/sem_ch8.adb
View File

@ -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);

12
gcc/ada/sem_elab.adb
View File

@ -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.

32
gcc/ada/sinfo.adb
View File

@ -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

64
gcc/ada/sinfo.ads
View File

@ -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);