sem_elab.adb: Change name Is_Package to Is_Package_Or_Generic_Package
2005-11-14 Robert Dewar <dewar@adacore.com> Ed Schonberg <schonberg@adacore.com> * sem_elab.adb: Change name Is_Package to Is_Package_Or_Generic_Package (Check_Elab_Call): A call within a protected body is never an elaboration call, and does not require checking. (Same_Elaboration_Scope): Take into account protected types for both entities. (Activate_Elaborate_All_Desirable): New procedure * ali.ads, ali.adb: Implement new AD/ED for Elaborate_All/Elaborate desirable * binde.adb: Implement new AD/ED for Elaborate_All/Elaborate desirable (Elab_Error_Msg): Use -da to include internal unit links, not -de. * lib-writ.ads, lib-writ.adb: Implement new AD/ED for Elaborate_All/Elaborate desirable Use new Elaborate_All_Desirable flag in N_With_Clause node * sinfo.ads, sinfo.adb (Actual_Designated_Subtype): New attribute for N_Free_Statement nodes. Define new class N_Subprogram_Instantiation Add Elaborate_Desirable flag to N_With_Clause node Add N_Delay_Statement (covering two kinds of delay) * debug.adb: Introduce d.f flag for compiler Add -da switch for binder From-SVN: r106968
This commit is contained in:
parent
104e4daaa5
commit
bde33286bd
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -1556,6 +1556,7 @@ package body ALI is
|
|||
Withs.Table (Withs.Last).Uname := Get_Name;
|
||||
Withs.Table (Withs.Last).Elaborate := False;
|
||||
Withs.Table (Withs.Last).Elaborate_All := False;
|
||||
Withs.Table (Withs.Last).Elab_Desirable := False;
|
||||
Withs.Table (Withs.Last).Elab_All_Desirable := False;
|
||||
Withs.Table (Withs.Last).SAL_Interface := False;
|
||||
|
||||
|
@ -1571,12 +1572,24 @@ package body ALI is
|
|||
Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
|
||||
Withs.Table (Withs.Last).Afile := Get_Name;
|
||||
|
||||
-- Scan out possible E, EA, and NE parameters
|
||||
-- Scan out possible E, EA, ED, and AD parameters
|
||||
|
||||
while not At_Eol loop
|
||||
Skip_Space;
|
||||
|
||||
if Nextc = 'E' then
|
||||
if Nextc = 'A' then
|
||||
P := P + 1;
|
||||
Checkc ('D');
|
||||
Check_At_End_Of_Field;
|
||||
|
||||
-- Store AD indication unless ignore required
|
||||
|
||||
if not Ignore_ED then
|
||||
Withs.Table (Withs.Last).Elab_All_Desirable :=
|
||||
True;
|
||||
end if;
|
||||
|
||||
elsif Nextc = 'E' then
|
||||
P := P + 1;
|
||||
|
||||
if At_End_Of_Field then
|
||||
|
@ -1594,7 +1607,7 @@ package body ALI is
|
|||
-- Store ED indication unless ignore required
|
||||
|
||||
if not Ignore_ED then
|
||||
Withs.Table (Withs.Last).Elab_All_Desirable :=
|
||||
Withs.Table (Withs.Last).Elab_Desirable :=
|
||||
True;
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -473,6 +473,9 @@ package ALI is
|
|||
-- Indicates presence of EA parameter
|
||||
|
||||
Elab_All_Desirable : Boolean;
|
||||
-- Indicates presence of AD parameter
|
||||
|
||||
Elab_Desirable : Boolean;
|
||||
-- Indicates presence of ED parameter
|
||||
|
||||
SAL_Interface : Boolean := False;
|
||||
|
@ -872,7 +875,7 @@ package ALI is
|
|||
-- switch description settings.
|
||||
--
|
||||
-- Ignore_ED is normally False. If set to True, it indicates that
|
||||
-- all ED (elaboration desirable) indications in the ALI file are
|
||||
-- all AD/ED (elaboration desirable) indications in the ALI file are
|
||||
-- to be ignored. This parameter is obsolete now that the -f switch
|
||||
-- is removed from gnatbind, and should be removed ???
|
||||
--
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -72,11 +72,16 @@ package body Binde is
|
|||
-- elaborated before unit X is elaborated. The Elab_All_Link list
|
||||
-- traces the dependencies in the latter case.
|
||||
|
||||
Elab_Desirable,
|
||||
Elab_All_Desirable,
|
||||
-- This is just like Elab_All, except that the elaborate all was not
|
||||
-- explicitly present in the source, but rather was created by the
|
||||
-- front end, which decided that it was "desirable".
|
||||
|
||||
Elab_Desirable,
|
||||
-- This is just like Elab, except that the elaborate was not
|
||||
-- explicitly present in the source, but rather was created by the
|
||||
-- front end, which decided that it was "desirable".
|
||||
|
||||
Spec_First);
|
||||
-- After is a body, and Before is the corresponding spec
|
||||
|
||||
|
@ -249,7 +254,7 @@ package body Binde is
|
|||
Link : Elab_All_Id);
|
||||
-- Used to compute the transitive closure of elaboration links for an
|
||||
-- Elaborate_All pragma (Reason = Elab_All) or for an indication of
|
||||
-- Elaborate_All_Desirable (Reason = Elab_Desirable). Unit After has
|
||||
-- Elaborate_All_Desirable (Reason = Elab_All_Desirable). Unit After has
|
||||
-- a pragma Elaborate_All or the front end has determined that a reference
|
||||
-- probably requires Elaborate_All is required, and unit Before must be
|
||||
-- previously elaborated. First a link is built making sure that unit
|
||||
|
@ -268,8 +273,7 @@ package body Binde is
|
|||
|
||||
function Make_Elab_Entry
|
||||
(Unam : Unit_Name_Type;
|
||||
Link : Elab_All_Id)
|
||||
return Elab_All_Id;
|
||||
Link : Elab_All_Id) return Elab_All_Id;
|
||||
-- Make an Elab_All_Entries table entry with the given Unam and Link
|
||||
|
||||
function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id;
|
||||
|
@ -800,9 +804,9 @@ package body Binde is
|
|||
SL : Successor_Link renames Succ.Table (S);
|
||||
|
||||
begin
|
||||
-- Nothing to do if internal unit involved and no -de flag
|
||||
-- Nothing to do if internal unit involved and no -da flag
|
||||
|
||||
if not Debug_Flag_E
|
||||
if not Debug_Flag_A
|
||||
and then
|
||||
(Is_Internal_File_Name (Units.Table (SL.Before).Sfile)
|
||||
or else
|
||||
|
@ -841,7 +845,7 @@ package body Binde is
|
|||
(" reason: pragma Elaborate_All in unit &",
|
||||
Info => True);
|
||||
|
||||
when Elab_Desirable =>
|
||||
when Elab_All_Desirable =>
|
||||
Error_Msg_Output
|
||||
(" reason: implicit Elaborate_All in unit &",
|
||||
Info => True);
|
||||
|
@ -850,6 +854,15 @@ package body Binde is
|
|||
(" recompile & with -gnatwl for full details",
|
||||
Info => True);
|
||||
|
||||
when Elab_Desirable =>
|
||||
Error_Msg_Output
|
||||
(" reason: implicit Elaborate in unit &",
|
||||
Info => True);
|
||||
|
||||
Error_Msg_Output
|
||||
(" recompile & with -gnatwl for full details",
|
||||
Info => True);
|
||||
|
||||
when Spec_First =>
|
||||
Error_Msg_Output
|
||||
(" reason: spec always elaborated before body",
|
||||
|
@ -1092,7 +1105,7 @@ package body Binde is
|
|||
-- Now establish all the links we need
|
||||
|
||||
Elab_All_Links
|
||||
(Withed_Unit, U, Elab_Desirable,
|
||||
(Withed_Unit, U, Elab_All_Desirable,
|
||||
Make_Elab_Entry
|
||||
(Withs.Table (W).Uname, No_Elab_All_Link));
|
||||
|
||||
|
@ -1116,6 +1129,18 @@ package body Binde is
|
|||
(Corresponding_Body (Withed_Unit), U, Elab);
|
||||
end if;
|
||||
|
||||
-- Elaborate_Desirable case, for this we establish
|
||||
-- the same links as above, but with a different reason.
|
||||
|
||||
elsif Withs.Table (W).Elab_Desirable then
|
||||
Build_Link (Withed_Unit, U, Withed);
|
||||
|
||||
if Units.Table (Withed_Unit).Utype = Is_Spec then
|
||||
Build_Link
|
||||
(Corresponding_Body (Withed_Unit),
|
||||
U, Elab_Desirable);
|
||||
end if;
|
||||
|
||||
-- Case of normal WITH with no elaboration pragmas, just
|
||||
-- build the single link to the directly referenced unit
|
||||
|
||||
|
@ -1137,8 +1162,7 @@ package body Binde is
|
|||
|
||||
function Make_Elab_Entry
|
||||
(Unam : Unit_Name_Type;
|
||||
Link : Elab_All_Id)
|
||||
return Elab_All_Id
|
||||
Link : Elab_All_Id) return Elab_All_Id
|
||||
is
|
||||
begin
|
||||
Elab_All_Entries.Increment_Last;
|
||||
|
@ -1153,7 +1177,6 @@ package body Binde is
|
|||
|
||||
function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id is
|
||||
Info : constant Int := Get_Name_Table_Info (Uname);
|
||||
|
||||
begin
|
||||
pragma Assert (Info /= 0 and then Unit_Id (Info) /= No_Unit_Id);
|
||||
return Unit_Id (Info);
|
||||
|
@ -1172,12 +1195,20 @@ package body Binde is
|
|||
-- Determines if U is a waiting body, defined as a body which has
|
||||
-- not been elaborated, but whose spec has been elaborated.
|
||||
|
||||
---------------
|
||||
-- Body_Unit --
|
||||
---------------
|
||||
|
||||
function Body_Unit (U : Unit_Id) return Boolean is
|
||||
begin
|
||||
return Units.Table (U).Utype = Is_Body
|
||||
or else Units.Table (U).Utype = Is_Body_Only;
|
||||
end Body_Unit;
|
||||
|
||||
------------------
|
||||
-- Waiting_Body --
|
||||
------------------
|
||||
|
||||
function Waiting_Body (U : Unit_Id) return Boolean is
|
||||
begin
|
||||
return Units.Table (U).Utype = Is_Body and then
|
||||
|
@ -1186,10 +1217,10 @@ package body Binde is
|
|||
|
||||
-- Start of processing for Worse_Choice
|
||||
|
||||
-- Note: the checks here are applied in sequence, and the ordering is
|
||||
-- significant (i.e. the more important criteria are applied first).
|
||||
|
||||
begin
|
||||
-- Note: the checks here are applied in sequence, and the ordering is
|
||||
-- significant (i.e. the more important criteria are applied first).
|
||||
|
||||
-- If either unit is internal, then use Better_Choice, since the
|
||||
-- language requires that predefined units not mess up in the choice
|
||||
-- of elaboration order, and for internal units, any problems are
|
||||
|
@ -1277,7 +1308,7 @@ package body Binde is
|
|||
First_Name : Boolean := True;
|
||||
|
||||
begin
|
||||
if ST.Reason in Elab_All .. Elab_Desirable then
|
||||
if ST.Reason in Elab_All .. Elab_All_Desirable then
|
||||
L := ST.Elab_All_Link;
|
||||
while L /= No_Elab_All_Link loop
|
||||
Nam := Elab_All_Entries.Table (L).Needed_By;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -98,7 +98,7 @@ package body Debug is
|
|||
-- d.c
|
||||
-- d.d
|
||||
-- d.e
|
||||
-- d.f
|
||||
-- d.f Inhibit folding of static expressions
|
||||
-- d.g
|
||||
-- d.h
|
||||
-- d.i
|
||||
|
@ -132,7 +132,7 @@ package body Debug is
|
|||
|
||||
-- Debug flags for binder (GNATBIND)
|
||||
|
||||
-- da
|
||||
-- da All links (including internal units) listed if there is a cycle
|
||||
-- db
|
||||
-- dc List units as they are chosen
|
||||
-- dd
|
||||
|
@ -410,7 +410,7 @@ package body Debug is
|
|||
-- indications. This debug flag disconnects the tracking of constant
|
||||
-- values (see Exp_Ch2.Expand_Current_Value).
|
||||
|
||||
-- dN Do not generate file name information in exception messages.
|
||||
-- dN Do not generate file name information in exception messages
|
||||
|
||||
-- dO Output immediate error messages. This causes error messages to
|
||||
-- be output as soon as they are generated (disconnecting several
|
||||
|
@ -461,6 +461,10 @@ package body Debug is
|
|||
-- had Configurable_Run_Time_Mode set to True. This is useful in
|
||||
-- testing high integrity mode.
|
||||
|
||||
-- d.f Suppress folding of static expressions. This of course results
|
||||
-- in seriously non-conforming behavior, but is useful sometimes
|
||||
-- when tracking down handling of complex expressions.
|
||||
|
||||
-- d.x No exception handlers in generated code. This causes exception
|
||||
-- handlers to be eliminated from the generated code. They are still
|
||||
-- fully compiled and analyzed, they just get eliminated from the
|
||||
|
@ -511,6 +515,12 @@ package body Debug is
|
|||
-- Documentation for Binder Debug Flags --
|
||||
------------------------------------------
|
||||
|
||||
-- da Normally if there is an elaboration circularity, then in describing
|
||||
-- the cycle, links involving internal units are omitted, since they
|
||||
-- are irrelevant and confusing. This debug flag causes all links to
|
||||
-- be listed, and is useful when diagnosing circularities introduced
|
||||
-- by incorrect changes to the run-time library itself.
|
||||
|
||||
-- dc List units as they are chosen. As units are selected for addition to
|
||||
-- the elaboration order, a line of output is generated showing which
|
||||
-- unit has been selected.
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -182,6 +182,9 @@ package body Lib.Writ is
|
|||
-- Array of flags to show which units have pragma Elaborate All set
|
||||
|
||||
Elab_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
|
||||
-- Array of flags to show which units have Elaborate_Desirable set
|
||||
|
||||
Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
|
||||
-- Array of flags to show which units have Elaborate_All_Desirable set
|
||||
|
||||
Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
|
||||
|
@ -229,11 +232,13 @@ package body Lib.Writ is
|
|||
Item := First (Context_Items (Cunit));
|
||||
while Present (Item) loop
|
||||
|
||||
-- Process with clause
|
||||
|
||||
-- Ada 2005 (AI-50217): limited with_clauses do not create
|
||||
-- dependencies
|
||||
|
||||
if Nkind (Item) = N_With_Clause
|
||||
and then not (Limited_Present (Item))
|
||||
and then not (Limited_Present (Item))
|
||||
then
|
||||
Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
|
||||
With_Flags (Unum) := True;
|
||||
|
@ -246,7 +251,11 @@ package body Lib.Writ is
|
|||
Elab_All_Flags (Unum) := True;
|
||||
end if;
|
||||
|
||||
if Elaborate_All_Desirable (Cunit_Entity (Unum)) then
|
||||
if Elaborate_All_Desirable (Item) then
|
||||
Elab_All_Des_Flags (Unum) := True;
|
||||
end if;
|
||||
|
||||
if Elaborate_Desirable (Item) then
|
||||
Elab_Des_Flags (Unum) := True;
|
||||
end if;
|
||||
end if;
|
||||
|
@ -495,10 +504,11 @@ package body Lib.Writ is
|
|||
-- Generate with lines, first those that are directly with'ed
|
||||
|
||||
for J in With_Flags'Range loop
|
||||
With_Flags (J) := False;
|
||||
Elab_Flags (J) := False;
|
||||
Elab_All_Flags (J) := False;
|
||||
Elab_Des_Flags (J) := False;
|
||||
With_Flags (J) := False;
|
||||
Elab_Flags (J) := False;
|
||||
Elab_All_Flags (J) := False;
|
||||
Elab_Des_Flags (J) := False;
|
||||
Elab_All_Des_Flags (J) := False;
|
||||
end loop;
|
||||
|
||||
Collect_Withs (Unode);
|
||||
|
@ -725,6 +735,10 @@ package body Lib.Writ is
|
|||
if Elab_Des_Flags (Unum) then
|
||||
Write_Info_Str (" ED");
|
||||
end if;
|
||||
|
||||
if Elab_All_Des_Flags (Unum) then
|
||||
Write_Info_Str (" AD");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Write_Info_EOL;
|
||||
|
@ -818,12 +832,10 @@ package body Lib.Writ is
|
|||
|
||||
begin
|
||||
if Nkind (U) = N_Subprogram_Body
|
||||
or else (Nkind (U) = N_Package_Body
|
||||
and then
|
||||
(Nkind (Original_Node (U)) = N_Function_Instantiation
|
||||
or else
|
||||
Nkind (Original_Node (U)) =
|
||||
N_Procedure_Instantiation))
|
||||
or else
|
||||
(Nkind (U) = N_Package_Body
|
||||
and then
|
||||
Nkind (Original_Node (U)) in N_Subprogram_Instantiation)
|
||||
then
|
||||
-- If the unit is a subprogram instance, the entity for the
|
||||
-- subprogram is the alias of the visible entity, which is the
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -462,7 +462,7 @@ package Lib.Writ is
|
|||
|
||||
-- Following each U line, is a series of lines of the form
|
||||
|
||||
-- W unit-name [source-name lib-name] [E] [EA] [ED]
|
||||
-- W unit-name [source-name lib-name] [E] [EA] [ED] [AD]
|
||||
--
|
||||
-- One of these lines is present for each unit that is mentioned in
|
||||
-- an explicit with clause by the current unit. The first parameter
|
||||
|
@ -479,11 +479,17 @@ package Lib.Writ is
|
|||
--
|
||||
-- EA pragma Elaborate_All applies to this unit
|
||||
--
|
||||
-- ED Elaborate_All_Desirable set for this unit, which means
|
||||
-- ED Elaborate_Desirable set for this unit, which means
|
||||
-- that there is no Elaborate, but the analysis suggests
|
||||
-- that Program_Error may be raised if the Elaborate
|
||||
-- conditions cannot be satisfied. The binder will attempt
|
||||
-- to treat ED as E if it can.
|
||||
--
|
||||
-- AD Elaborate_All_Desirable set for this unit, which means
|
||||
-- that there is no Elaborate_All, but the analysis suggests
|
||||
-- that Program_Error may be raised if the Elaborate_All
|
||||
-- conditions cannot be satisfied. The binder will attempt
|
||||
-- to treat ED as EA if it can.
|
||||
-- to treat AD as EA if it can.
|
||||
--
|
||||
-- The parameter source-name and lib-name are omitted for the case
|
||||
-- of a generic unit compiled with earlier versions of GNAT which
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1997-2005, 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- --
|
||||
|
@ -117,7 +117,6 @@ package body Sem_Elab is
|
|||
|
||||
Outer_Scope : Entity_Id;
|
||||
-- Save scope of outer level call
|
||||
|
||||
end record;
|
||||
|
||||
package Delay_Check is new Table.Table (
|
||||
|
@ -166,6 +165,13 @@ package body Sem_Elab is
|
|||
-- then the original call was an inner call, and we are not interested
|
||||
-- in calls that go outside this scope.
|
||||
|
||||
procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id);
|
||||
-- Analysis of construct N shows that we should set Elaborate_All_Desirable
|
||||
-- for the WITH clause for unit U (which will always be present). A special
|
||||
-- case is when N is a function or procedure instantiation, in which case
|
||||
-- it is sufficient to set Elaborate_Desirable, since in this case there is
|
||||
-- no possibility of transitive elaboration issues.
|
||||
|
||||
procedure Check_A_Call
|
||||
(N : Node_Id;
|
||||
E : Entity_Id;
|
||||
|
@ -308,6 +314,113 @@ package body Sem_Elab is
|
|||
-- which the pragma applies. This prevents spurious warnings when the
|
||||
-- called entity is renamed within U.
|
||||
|
||||
--------------------------------------
|
||||
-- Activate_Elaborate_All_Desirable --
|
||||
--------------------------------------
|
||||
|
||||
procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id) is
|
||||
UN : constant Unit_Number_Type := Get_Code_Unit (N);
|
||||
CU : constant Node_Id := Cunit (UN);
|
||||
UE : constant Entity_Id := Cunit_Entity (UN);
|
||||
Unm : constant Unit_Name_Type := Unit_Name (UN);
|
||||
CI : constant List_Id := Context_Items (CU);
|
||||
Itm : Node_Id;
|
||||
Ent : Entity_Id;
|
||||
|
||||
procedure Set_Elab_Flag (Itm : Node_Id);
|
||||
-- Sets Elaborate_[All_]Desirable as appropriate on Itm
|
||||
|
||||
-------------------
|
||||
-- Set_Elab_Flag --
|
||||
-------------------
|
||||
|
||||
procedure Set_Elab_Flag (Itm : Node_Id) is
|
||||
begin
|
||||
if Nkind (N) in N_Subprogram_Instantiation then
|
||||
Set_Elaborate_Desirable (Itm);
|
||||
else
|
||||
Set_Elaborate_All_Desirable (Itm);
|
||||
end if;
|
||||
end Set_Elab_Flag;
|
||||
|
||||
-- Start of processing for Activate_Elaborate_All_Desirable
|
||||
|
||||
begin
|
||||
Itm := First (CI);
|
||||
while Present (Itm) loop
|
||||
if Nkind (Itm) = N_With_Clause then
|
||||
Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));
|
||||
|
||||
-- If we find it, then mark elaborate all desirable and return
|
||||
|
||||
if U = Ent then
|
||||
Set_Elab_Flag (Itm);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Itm);
|
||||
end loop;
|
||||
|
||||
-- If we fall through then the with clause is not present in the
|
||||
-- current unit. One legitimate possibility is that the with clause
|
||||
-- is present in the spec when we are a body.
|
||||
|
||||
if Is_Body_Name (Unm) then
|
||||
declare
|
||||
UEs : constant Entity_Id := Spec_Entity (UE);
|
||||
UNs : constant Unit_Number_Type := Get_Source_Unit (UEs);
|
||||
CUs : constant Node_Id := Cunit (UNs);
|
||||
CIs : constant List_Id := Context_Items (CUs);
|
||||
|
||||
begin
|
||||
Itm := First (CIs);
|
||||
while Present (Itm) loop
|
||||
if Nkind (Itm) = N_With_Clause then
|
||||
Ent :=
|
||||
Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));
|
||||
|
||||
if U = Ent then
|
||||
|
||||
-- If we find it, we have to create an implicit copy
|
||||
-- of the with clause for the body, just so that it
|
||||
-- can be marked as elaborate desirable (it would be
|
||||
-- wrong to put it on the spec item, since it is the
|
||||
-- body that has possible elaboration problems, not
|
||||
-- the spec.
|
||||
|
||||
declare
|
||||
CW : constant Node_Id :=
|
||||
Make_With_Clause (Sloc (Itm),
|
||||
Name => Name (Itm));
|
||||
|
||||
begin
|
||||
Set_Library_Unit (CW, Library_Unit (Itm));
|
||||
Set_Implicit_With (CW, True);
|
||||
|
||||
-- Set elaborate all desirable on copy and then
|
||||
-- append the copy to the list of body with's
|
||||
-- and we are done.
|
||||
|
||||
Set_Elab_Flag (CW);
|
||||
Append_To (CI, CW);
|
||||
return;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Itm);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Here if we do not find with clause on spec or body. We just ignore
|
||||
-- this case, it means that the elaboration involves some other unit
|
||||
-- than the unit being compiled, and will be caught elsewhere.
|
||||
|
||||
null;
|
||||
end Activate_Elaborate_All_Desirable;
|
||||
|
||||
------------------
|
||||
-- Check_A_Call --
|
||||
------------------
|
||||
|
@ -370,7 +483,7 @@ package body Sem_Elab is
|
|||
|
||||
if (Nkind (N) = N_Function_Call
|
||||
or else Nkind (N) = N_Procedure_Call_Statement)
|
||||
and then No_Elaboration_Check (N)
|
||||
and then No_Elaboration_Check (N)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
@ -710,8 +823,15 @@ package body Sem_Elab is
|
|||
end if;
|
||||
|
||||
Error_Msg_Qual_Level := Nat'Last;
|
||||
Error_Msg_NE
|
||||
("\missing pragma Elaborate_All for&?", N, W_Scope);
|
||||
|
||||
if Nkind (N) in N_Subprogram_Instantiation then
|
||||
Error_Msg_NE
|
||||
("\missing pragma Elaborate for&?", N, W_Scope);
|
||||
else
|
||||
Error_Msg_NE
|
||||
("\missing pragma Elaborate_All for&?", N, W_Scope);
|
||||
end if;
|
||||
|
||||
Error_Msg_Qual_Level := 0;
|
||||
Output_Calls (N);
|
||||
|
||||
|
@ -893,7 +1013,6 @@ package body Sem_Elab is
|
|||
("\?Program_Error will be raised at run time", N);
|
||||
Insert_Elab_Check (N);
|
||||
Set_ABE_Is_Certain (N);
|
||||
|
||||
end Check_Bad_Instantiation;
|
||||
|
||||
---------------------
|
||||
|
@ -1110,13 +1229,19 @@ package body Sem_Elab is
|
|||
return;
|
||||
end if;
|
||||
|
||||
if Nkind (P) = N_Subprogram_Body
|
||||
or else
|
||||
Nkind (P) = N_Protected_Body
|
||||
-- A protected body has no elaboration code and contains
|
||||
-- only other bodies.
|
||||
|
||||
if Nkind (P) = N_Protected_Body then
|
||||
return;
|
||||
|
||||
elsif Nkind (P) = N_Subprogram_Body
|
||||
or else
|
||||
Nkind (P) = N_Task_Body
|
||||
or else
|
||||
Nkind (P) = N_Block_Statement
|
||||
or else
|
||||
Nkind (P) = N_Entry_Body
|
||||
then
|
||||
if L = Declarations (P) then
|
||||
exit;
|
||||
|
@ -1510,7 +1635,6 @@ package body Sem_Elab is
|
|||
else
|
||||
Check_Internal_Call_Continue (N, E, Outer_Scope, Orig_Ent);
|
||||
end if;
|
||||
|
||||
end Check_Internal_Call;
|
||||
|
||||
----------------------------------
|
||||
|
@ -1661,9 +1785,9 @@ package body Sem_Elab is
|
|||
-- does not normally visit subprogram bodies.
|
||||
|
||||
declare
|
||||
Decl : Node_Id := First (Declarations (Sbody));
|
||||
|
||||
Decl : Node_Id;
|
||||
begin
|
||||
Decl := First (Declarations (Sbody));
|
||||
while Present (Decl) loop
|
||||
Traverse (Decl);
|
||||
Next (Decl);
|
||||
|
@ -1830,7 +1954,6 @@ package body Sem_Elab is
|
|||
and then Has_Task (Base_Type (Typ))
|
||||
then
|
||||
Comp := First_Component (Typ);
|
||||
|
||||
while Present (Comp) loop
|
||||
Add_Task_Proc (Etype (Comp));
|
||||
Comp := Next_Component (Comp);
|
||||
|
@ -1874,10 +1997,9 @@ package body Sem_Elab is
|
|||
end if;
|
||||
|
||||
else
|
||||
Elmt := First_Elmt (Inter_Procs);
|
||||
|
||||
-- No need for multiple entries of the same type
|
||||
|
||||
Elmt := First_Elmt (Inter_Procs);
|
||||
while Present (Elmt) loop
|
||||
if Node (Elmt) = Proc then
|
||||
return;
|
||||
|
@ -1899,9 +2021,7 @@ package body Sem_Elab is
|
|||
begin
|
||||
if Present (Decls) then
|
||||
Decl := First (Decls);
|
||||
|
||||
while Present (Decl) loop
|
||||
|
||||
if Nkind (Decl) = N_Object_Declaration
|
||||
and then Has_Task (Etype (Defining_Identifier (Decl)))
|
||||
then
|
||||
|
@ -1918,9 +2038,10 @@ package body Sem_Elab is
|
|||
----------------
|
||||
|
||||
function Outer_Unit (E : Entity_Id) return Entity_Id is
|
||||
Outer : Entity_Id := E;
|
||||
Outer : Entity_Id;
|
||||
|
||||
begin
|
||||
Outer := E;
|
||||
while Present (Outer) loop
|
||||
if Elaboration_Checks_Suppressed (Outer) then
|
||||
Cunit_SC := True;
|
||||
|
@ -1970,7 +2091,6 @@ package body Sem_Elab is
|
|||
-- the task body to be elaborated before the current one.
|
||||
|
||||
Elmt := First_Elmt (Inter_Procs);
|
||||
|
||||
while Present (Elmt) loop
|
||||
Ent := Node (Elmt);
|
||||
Task_Scope := Outer_Unit (Scope (Ent));
|
||||
|
@ -2014,7 +2134,7 @@ package body Sem_Elab is
|
|||
" requires pragma Elaborate_All on &?", N, Ent);
|
||||
end if;
|
||||
|
||||
Set_Elaborate_All_Desirable (Task_Scope);
|
||||
Activate_Elaborate_All_Desirable (N, Task_Scope);
|
||||
Set_Suppress_Elaboration_Warnings (Task_Scope);
|
||||
end if;
|
||||
|
||||
|
@ -2025,8 +2145,8 @@ package body Sem_Elab is
|
|||
-- the task procedure bodies, which are available.
|
||||
|
||||
In_Task_Activation := True;
|
||||
Elmt := First_Elmt (Intra_Procs);
|
||||
|
||||
Elmt := First_Elmt (Intra_Procs);
|
||||
while Present (Elmt) loop
|
||||
Ent := Node (Elmt);
|
||||
Check_Internal_Call_Continue (N, Ent, Enclosing, Ent);
|
||||
|
@ -2060,7 +2180,7 @@ package body Sem_Elab is
|
|||
or else
|
||||
(Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
|
||||
then
|
||||
Set_Elaborate_All_Desirable (Scop);
|
||||
Activate_Elaborate_All_Desirable (Call, Scop);
|
||||
Set_Suppress_Elaboration_Warnings (Scop, True);
|
||||
return;
|
||||
end if;
|
||||
|
@ -2077,13 +2197,14 @@ package body Sem_Elab is
|
|||
null; -- detailed processing follows.
|
||||
|
||||
else
|
||||
Set_Elaborate_All_Desirable (Scop);
|
||||
Activate_Elaborate_All_Desirable (Call, Scop);
|
||||
Set_Suppress_Elaboration_Warnings (Scop, True);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If the unit is not in the context, there must be an intermediate
|
||||
-- unit that is, on which we need to place to elaboration flag.
|
||||
-- unit that is, on which we need to place to elaboration flag. This
|
||||
-- happens with init proc calls.
|
||||
|
||||
if Is_Init_Proc (Subp)
|
||||
or else Init_Call
|
||||
|
@ -2098,22 +2219,22 @@ package body Sem_Elab is
|
|||
Etype (First (Parameter_Associations (Call)));
|
||||
begin
|
||||
Elab_Unit := Scope (Typ);
|
||||
|
||||
while (Present (Elab_Unit))
|
||||
and then not Is_Compilation_Unit (Elab_Unit)
|
||||
loop
|
||||
Elab_Unit := Scope (Elab_Unit);
|
||||
end loop;
|
||||
end;
|
||||
|
||||
-- If original node uses selected component notation, the prefix is
|
||||
-- visible and determines the scope that must be elaborated. After
|
||||
-- rewriting, the prefix is the first actual in the call.
|
||||
|
||||
elsif Nkind (Original_Node (Call)) = N_Selected_Component then
|
||||
|
||||
-- If original node uses selected component notation, the
|
||||
-- prefix is visible and determines the scope that must be
|
||||
-- elaborated. After rewriting, the prefix is the first actual
|
||||
-- in the call.
|
||||
|
||||
Elab_Unit := Scope (Etype (First (Parameter_Associations (Call))));
|
||||
|
||||
-- Not one of special cases above
|
||||
|
||||
else
|
||||
-- Using previously computed scope. If the elaboration check is
|
||||
-- done after analysis, the scope is not visible any longer, but
|
||||
|
@ -2122,7 +2243,7 @@ package body Sem_Elab is
|
|||
Elab_Unit := Scop;
|
||||
end if;
|
||||
|
||||
Set_Elaborate_All_Desirable (Elab_Unit);
|
||||
Activate_Elaborate_All_Desirable (Call, Elab_Unit);
|
||||
Set_Suppress_Elaboration_Warnings (Elab_Unit, True);
|
||||
end Set_Elaboration_Constraint;
|
||||
|
||||
|
@ -2268,7 +2389,7 @@ package body Sem_Elab is
|
|||
|
||||
-- Otherwise look and see if we are embedded in a further package
|
||||
|
||||
elsif Is_Package (Scop) then
|
||||
elsif Is_Package_Or_Generic_Package (Scop) then
|
||||
|
||||
-- If so, get the body of the enclosing package, and look in
|
||||
-- its package body for the package body we are looking for.
|
||||
|
@ -2311,16 +2432,15 @@ package body Sem_Elab is
|
|||
-- Case of entity is in other than a package spec, in this case
|
||||
-- the body, if present, must be in the same declarative part.
|
||||
|
||||
if not Is_Package (Scop) then
|
||||
if not Is_Package_Or_Generic_Package (Scop) then
|
||||
declare
|
||||
P : Node_Id;
|
||||
|
||||
begin
|
||||
P := Declaration_Node (Ent);
|
||||
|
||||
-- Declaration node may get us a spec, so if so, go to
|
||||
-- the parent declaration.
|
||||
|
||||
P := Declaration_Node (Ent);
|
||||
while not Is_List_Member (P) loop
|
||||
P := Parent (P);
|
||||
end loop;
|
||||
|
@ -2532,18 +2652,26 @@ package body Sem_Elab is
|
|||
----------------------------
|
||||
|
||||
function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean is
|
||||
S1 : Entity_Id := Scop1;
|
||||
S2 : Entity_Id := Scop2;
|
||||
S1 : Entity_Id;
|
||||
S2 : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Find elaboration scope for Scop1
|
||||
|
||||
S1 := Scop1;
|
||||
while S1 /= Standard_Standard
|
||||
and then (Ekind (S1) = E_Package
|
||||
or else
|
||||
Ekind (S1) = E_Protected_Type
|
||||
or else
|
||||
Ekind (S1) = E_Block)
|
||||
loop
|
||||
S1 := Scope (S1);
|
||||
end loop;
|
||||
|
||||
-- Find elaboration scope for Scop2
|
||||
|
||||
S2 := Scop2;
|
||||
while S2 /= Standard_Standard
|
||||
and then (Ekind (S2) = E_Package
|
||||
or else
|
||||
|
@ -2606,7 +2734,6 @@ package body Sem_Elab is
|
|||
if Nkind (N) = N_Subprogram_Declaration then
|
||||
declare
|
||||
Ent : constant Entity_Id := Defining_Unit_Name (Specification (N));
|
||||
|
||||
begin
|
||||
Set_Is_Imported (Ent);
|
||||
Set_Convention (Ent, Convention_Stubbed);
|
||||
|
@ -2615,7 +2742,6 @@ package body Sem_Elab is
|
|||
elsif Nkind (N) = N_Package_Declaration then
|
||||
declare
|
||||
Spec : constant Node_Id := Specification (N);
|
||||
|
||||
begin
|
||||
New_Scope (Defining_Unit_Name (Spec));
|
||||
Supply_Bodies (Visible_Declarations (Spec));
|
||||
|
@ -2627,7 +2753,6 @@ package body Sem_Elab is
|
|||
|
||||
procedure Supply_Bodies (L : List_Id) is
|
||||
Elmt : Node_Id;
|
||||
|
||||
begin
|
||||
if Present (L) then
|
||||
Elmt := First (L);
|
||||
|
@ -2647,7 +2772,6 @@ package body Sem_Elab is
|
|||
|
||||
begin
|
||||
Scop := E1;
|
||||
|
||||
loop
|
||||
if Scop = E2 then
|
||||
return True;
|
||||
|
@ -2675,25 +2799,23 @@ package body Sem_Elab is
|
|||
|
||||
begin
|
||||
Item := First (Context_Items (Cunit (Current_Sem_Unit)));
|
||||
|
||||
while Present (Item) loop
|
||||
if Nkind (Item) = N_Pragma
|
||||
and then Get_Pragma_Id (Chars (Item)) = Pragma_Elaborate_All
|
||||
then
|
||||
-- Return if some previous error on the pragma itself
|
||||
|
||||
if Error_Posted (Item) then
|
||||
|
||||
-- Some previous error on the pragma itself
|
||||
|
||||
return False;
|
||||
end if;
|
||||
|
||||
Elab_Id :=
|
||||
Entity (
|
||||
Expression (First (Pragma_Argument_Associations (Item))));
|
||||
Entity
|
||||
(Expression (First (Pragma_Argument_Associations (Item))));
|
||||
|
||||
Par := Parent (Unit_Declaration_Node (Elab_Id));
|
||||
|
||||
Par := Parent (Unit_Declaration_Node (Elab_Id));
|
||||
Item2 := First (Context_Items (Par));
|
||||
|
||||
while Present (Item2) loop
|
||||
if Nkind (Item2) = N_With_Clause
|
||||
and then Entity (Name (Item2)) = E
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -175,6 +175,15 @@ package body Sinfo is
|
|||
return Flag4 (N);
|
||||
end Acts_As_Spec;
|
||||
|
||||
function Actual_Designated_Subtype
|
||||
(N : Node_Id) return Node_Id is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Explicit_Dereference
|
||||
or else NT (N).Nkind = N_Free_Statement);
|
||||
return Node2 (N);
|
||||
end Actual_Designated_Subtype;
|
||||
|
||||
function Aggregate_Bounds
|
||||
(N : Node_Id) return Node_Id is
|
||||
begin
|
||||
|
@ -876,6 +885,14 @@ package body Sinfo is
|
|||
return Flag13 (N);
|
||||
end Do_Tag_Check;
|
||||
|
||||
function Elaborate_All_Desirable
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_With_Clause);
|
||||
return Flag9 (N);
|
||||
end Elaborate_All_Desirable;
|
||||
|
||||
function Elaborate_All_Present
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
|
@ -884,6 +901,14 @@ package body Sinfo is
|
|||
return Flag14 (N);
|
||||
end Elaborate_All_Present;
|
||||
|
||||
function Elaborate_Desirable
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_With_Clause);
|
||||
return Flag11 (N);
|
||||
end Elaborate_Desirable;
|
||||
|
||||
function Elaborate_Present
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
|
@ -2745,6 +2770,15 @@ package body Sinfo is
|
|||
Set_Flag4 (N, Val);
|
||||
end Set_Acts_As_Spec;
|
||||
|
||||
procedure Set_Actual_Designated_Subtype
|
||||
(N : Node_Id; Val : Node_Id) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Explicit_Dereference
|
||||
or else NT (N).Nkind = N_Free_Statement);
|
||||
Set_Node2 (N, Val);
|
||||
end Set_Actual_Designated_Subtype;
|
||||
|
||||
procedure Set_Aggregate_Bounds
|
||||
(N : Node_Id; Val : Node_Id) is
|
||||
begin
|
||||
|
@ -3446,6 +3480,14 @@ package body Sinfo is
|
|||
Set_Flag13 (N, Val);
|
||||
end Set_Do_Tag_Check;
|
||||
|
||||
procedure Set_Elaborate_All_Desirable
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_With_Clause);
|
||||
Set_Flag9 (N, Val);
|
||||
end Set_Elaborate_All_Desirable;
|
||||
|
||||
procedure Set_Elaborate_All_Present
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
|
@ -3454,6 +3496,14 @@ package body Sinfo is
|
|||
Set_Flag14 (N, Val);
|
||||
end Set_Elaborate_All_Present;
|
||||
|
||||
procedure Set_Elaborate_Desirable
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_With_Clause);
|
||||
Set_Flag11 (N, Val);
|
||||
end Set_Elaborate_Desirable;
|
||||
|
||||
procedure Set_Elaborate_Present
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -90,11 +90,11 @@ package Sinfo is
|
|||
-- node in the checks.
|
||||
-- Add an appropriate section to the case statement in sprint.adb
|
||||
-- Add an appropriate section to the case statement in sem.adb
|
||||
-- Add an appropraite section to the case statement in exp_util.adb
|
||||
-- Add an appropriate section to the case statement in exp_util.adb
|
||||
-- (Insert_Actions procedure)
|
||||
-- For a subexpression, add an appropriate sections to the case
|
||||
-- For a subexpression, add an appropriate section to the case
|
||||
-- statement in sem_eval.adb
|
||||
-- For a subexpression, add an appropriate sections to the case
|
||||
-- For a subexpression, add an appropriate section to the case
|
||||
-- statement in sem_res.adb
|
||||
|
||||
-- Finally, four utility programs must be run:
|
||||
|
@ -457,27 +457,36 @@ package Sinfo is
|
|||
|
||||
-- The following flag fields appear in all nodes
|
||||
|
||||
-- Analyzed
|
||||
-- Analyzed (Flag1)
|
||||
-- This flag is used to indicate that a node (and all its children
|
||||
-- have been analyzed. It is used to avoid reanalysis of a node that
|
||||
-- has already been analyzed, both for efficiency and functional
|
||||
-- correctness reasons.
|
||||
|
||||
-- Error_Posted
|
||||
-- Comes_From_Source (Flag2)
|
||||
-- This flag is on for any nodes built by the scanner or parser from
|
||||
-- the source program, and off for any nodes built by the analyzer or
|
||||
-- expander. It indicates that a node comes from the original source.
|
||||
-- This flag is defined in Atree.
|
||||
|
||||
-- Error_Posted (Flag3)
|
||||
-- This flag is used to avoid multiple error messages being posted
|
||||
-- on or referring to the same node. This flag is set if an error
|
||||
-- message refers to a node or is posted on its source location,
|
||||
-- and has the effect of inhibiting further messages involving
|
||||
-- this same node.
|
||||
|
||||
-- Comes_From_Source
|
||||
-- This flag is on for any nodes built by the scanner or parser from
|
||||
-- the source program, and off for any nodes built by the analyzer or
|
||||
-- expander. It indicates that a node comes from the original source.
|
||||
-- This flag is defined in Atree.
|
||||
-- Has_Dynamic_Length_Check (Flag10-Sem)
|
||||
-- This flag is present on all nodes. It is set to indicate that one
|
||||
-- of the routines in unit Checks has generated a length check action
|
||||
-- which has been inserted at the flagged node. This is used to avoid
|
||||
-- the generation of duplicate checks.
|
||||
|
||||
-- Has_Dynamic_Length_Check and Has_Dynamic_Range_Check also appear on
|
||||
-- all nodes. They are fully described in the next section.
|
||||
-- Has_Dynamic_Range_Check (Flag12-Sem)
|
||||
-- This flag is present on all nodes. It is set to indicate that one
|
||||
-- of the routines in unit Checks has generated a range check action
|
||||
-- which has been inserted at the flagged node. This is used to avoid
|
||||
-- the generation of duplicate checks.
|
||||
|
||||
------------------------------------
|
||||
-- Description of Semantic Fields --
|
||||
|
@ -535,6 +544,15 @@ package Sinfo is
|
|||
-- compilation unit node at the library level for such a subprogram
|
||||
-- (see further description in spec of Lib package).
|
||||
|
||||
-- Actual_Designated_Subtype (Node2-Sem)
|
||||
-- Present in N_Free_Statement and N_Explicit_Dereference nodes. If
|
||||
-- GIGI needs to known the dynamic constrained subtype of the designated
|
||||
-- object, this attribute is set to that type. This is done for
|
||||
-- N_Free_Statements for access-to-classwide types and access to
|
||||
-- unconstrained packed array types, and for N_Explicit_Dereference
|
||||
-- when the designated type is an unconstrained packed array and the
|
||||
-- dereference is the prefix of a 'Size attribute reference.
|
||||
|
||||
-- Aggregate_Bounds (Node3-Sem)
|
||||
-- Present in array N_Aggregate nodes. If the aggregate contains
|
||||
-- component associations this field points to an N_Range node whose
|
||||
|
@ -831,13 +849,23 @@ package Sinfo is
|
|||
-- yet decided how this flag is used (TBD ???).
|
||||
|
||||
-- Elaborate_Present (Flag4-Sem)
|
||||
-- This flag is set in the N_With_Clause node to indicate that a
|
||||
-- pragma Elaborate pragma appears for the with'ed units.
|
||||
-- This flag is set in the N_With_Clause node to indicate that pragma
|
||||
-- Elaborate pragma appears for the with'ed units.
|
||||
|
||||
-- Elaborate_All_Desirable (Flag9-Sem)
|
||||
-- This flag is set in the N_With_Clause mode to indicate that the static
|
||||
-- elaboration processing has determined that an Elaborate_All pragma is
|
||||
-- desirable for correct elaboration for this unit.
|
||||
|
||||
-- Elaborate_All_Present (Flag14-Sem)
|
||||
-- This flag is set in the N_With_Clause node to indicate that a
|
||||
-- pragma Elaborate_All pragma appears for the with'ed units.
|
||||
|
||||
-- Elaborate_Desirable (Flag11-Sem)
|
||||
-- This flag is set in the N_With_Clause mode to indicate that the static
|
||||
-- elaboration processing has determined that an Elaborate pragma is
|
||||
-- desirable for correct elaboration for this unit.
|
||||
|
||||
-- Elaboration_Boolean (Node2-Sem)
|
||||
-- This field is present in function and procedure specification
|
||||
-- nodes. If set, it points to the entity for a Boolean flag that
|
||||
|
@ -1008,18 +1036,6 @@ package Sinfo is
|
|||
-- handler is deleted during optimization. For further details on why
|
||||
-- this is required, see Exp_Ch11.Remove_Handler_Entries.
|
||||
|
||||
-- Has_Dynamic_Length_Check (Flag10-Sem)
|
||||
-- This flag is present on all nodes. It is set to indicate that one
|
||||
-- of the routines in unit Checks has generated a length check action
|
||||
-- which has been inserted at the flagged node. This is used to avoid
|
||||
-- the generation of duplicate checks.
|
||||
|
||||
-- Has_Dynamic_Range_Check (Flag12-Sem)
|
||||
-- This flag is present on all nodes. It is set to indicate that one
|
||||
-- of the routines in unit Checks has generated a range check action
|
||||
-- which has been inserted at the flagged node. This is used to avoid
|
||||
-- the generation of duplicate checks.
|
||||
|
||||
-- Has_No_Elaboration_Code (Flag17-Sem)
|
||||
-- A flag that appears in the N_Compilation_Unit node to indicate
|
||||
-- whether or not elaboration code is present for this unit. It is
|
||||
|
@ -2847,6 +2863,7 @@ package Sinfo is
|
|||
-- N_Explicit_Dereference
|
||||
-- Sloc points to ALL
|
||||
-- Prefix (Node3)
|
||||
-- Actual_Designated_Subtype (Node2-Sem)
|
||||
-- plus fields for expression
|
||||
|
||||
-------------------------------
|
||||
|
@ -5217,6 +5234,8 @@ package Sinfo is
|
|||
-- Context_Installed (Flag13-Sem)
|
||||
-- Elaborate_Present (Flag4-Sem)
|
||||
-- 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)
|
||||
-- Limited_Present (Flag17) set if LIMITED is present
|
||||
|
@ -6233,6 +6252,7 @@ package Sinfo is
|
|||
-- Expression (Node3) argument to unchecked deallocation call
|
||||
-- Storage_Pool (Node1-Sem)
|
||||
-- Procedure_To_Call (Node4-Sem)
|
||||
-- Actual_Designated_Subtype (Node2-Sem)
|
||||
|
||||
-- Note: in the case where a debug source file is generated, the Sloc
|
||||
-- for this node points to the FREE keyword in the Sprint file output.
|
||||
|
@ -6757,11 +6777,15 @@ package Sinfo is
|
|||
N_Task_Body_Stub,
|
||||
|
||||
-- N_Generic_Instantiation, N_Later_Decl_Item
|
||||
-- N_Subprogram_Instantiation
|
||||
|
||||
N_Function_Instantiation,
|
||||
N_Package_Instantiation,
|
||||
N_Procedure_Instantiation,
|
||||
|
||||
-- N_Generic_Instantiation, N_Later_Decl_Item
|
||||
|
||||
N_Package_Instantiation,
|
||||
|
||||
-- N_Unit_Body, N_Later_Decl_Item, N_Proper_Body
|
||||
|
||||
N_Package_Body,
|
||||
|
@ -6797,7 +6821,7 @@ package Sinfo is
|
|||
N_Package_Renaming_Declaration,
|
||||
N_Subprogram_Renaming_Declaration,
|
||||
|
||||
-- N_Generic_Renaming_Declarations, N_Renaming_Declaration
|
||||
-- N_Generic_Renaming_Declaration, N_Renaming_Declaration
|
||||
|
||||
N_Generic_Function_Renaming_Declaration,
|
||||
N_Generic_Package_Renaming_Declaration,
|
||||
|
@ -6813,8 +6837,14 @@ package Sinfo is
|
|||
N_Case_Statement,
|
||||
N_Code_Statement,
|
||||
N_Conditional_Entry_Call,
|
||||
|
||||
-- N_Statement_Other_Than_Procedure_Call. N_Delay_Statement
|
||||
|
||||
N_Delay_Relative_Statement,
|
||||
N_Delay_Until_Statement,
|
||||
|
||||
-- N_Statement_Other_Than_Procedure_Call
|
||||
|
||||
N_Entry_Call_Statement,
|
||||
N_Free_Statement,
|
||||
N_Goto_Statement,
|
||||
|
@ -6940,6 +6970,10 @@ package Sinfo is
|
|||
-- Note: this includes all constructs normally thought of as declarations
|
||||
-- except those which are separately grouped as later declarations.
|
||||
|
||||
subtype N_Delay_Statement is Node_Kind range
|
||||
N_Delay_Relative_Statement ..
|
||||
N_Delay_Until_Statement;
|
||||
|
||||
subtype N_Direct_Name is Node_Kind range
|
||||
N_Identifier ..
|
||||
N_Character_Literal;
|
||||
|
@ -6958,7 +6992,7 @@ package Sinfo is
|
|||
|
||||
subtype N_Generic_Instantiation is Node_Kind range
|
||||
N_Function_Instantiation ..
|
||||
N_Procedure_Instantiation;
|
||||
N_Package_Instantiation;
|
||||
|
||||
subtype N_Generic_Renaming_Declaration is Node_Kind range
|
||||
N_Generic_Function_Renaming_Declaration ..
|
||||
|
@ -7036,6 +7070,10 @@ package Sinfo is
|
|||
-- (since overloading is possible, so it needs to go through the normal
|
||||
-- overloading resolution for expressions).
|
||||
|
||||
subtype N_Subprogram_Instantiation is Node_Kind range
|
||||
N_Function_Instantiation ..
|
||||
N_Procedure_Instantiation;
|
||||
|
||||
subtype N_Has_Condition is Node_Kind range
|
||||
N_Exit_Statement ..
|
||||
N_Terminate_Alternative;
|
||||
|
@ -7106,6 +7144,9 @@ package Sinfo is
|
|||
function Acts_As_Spec
|
||||
(N : Node_Id) return Boolean; -- Flag4
|
||||
|
||||
function Actual_Designated_Subtype
|
||||
(N : Node_Id) return Node_Id; -- Node2
|
||||
|
||||
function Aggregate_Bounds
|
||||
(N : Node_Id) return Node_Id; -- Node3
|
||||
|
||||
|
@ -7325,9 +7366,15 @@ package Sinfo is
|
|||
function Do_Tag_Check
|
||||
(N : Node_Id) return Boolean; -- Flag13
|
||||
|
||||
function Elaborate_All_Desirable
|
||||
(N : Node_Id) return Boolean; -- Flag9
|
||||
|
||||
function Elaborate_All_Present
|
||||
(N : Node_Id) return Boolean; -- Flag14
|
||||
|
||||
function Elaborate_Desirable
|
||||
(N : Node_Id) return Boolean; -- Flag11
|
||||
|
||||
function Elaborate_Present
|
||||
(N : Node_Id) return Boolean; -- Flag4
|
||||
|
||||
|
@ -7919,6 +7966,9 @@ package Sinfo is
|
|||
procedure Set_Acts_As_Spec
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag4
|
||||
|
||||
procedure Set_Actual_Designated_Subtype
|
||||
(N : Node_Id; Val : Node_Id); -- Node2
|
||||
|
||||
procedure Set_Aggregate_Bounds
|
||||
(N : Node_Id; Val : Node_Id); -- Node3
|
||||
|
||||
|
@ -8138,9 +8188,15 @@ package Sinfo is
|
|||
procedure Set_Do_Tag_Check
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag13
|
||||
|
||||
procedure Set_Elaborate_All_Desirable
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag9
|
||||
|
||||
procedure Set_Elaborate_All_Present
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag14
|
||||
|
||||
procedure Set_Elaborate_Desirable
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag11
|
||||
|
||||
procedure Set_Elaborate_Present
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag4
|
||||
|
||||
|
@ -8723,6 +8779,7 @@ package Sinfo is
|
|||
pragma Inline (Actions);
|
||||
pragma Inline (Activation_Chain_Entity);
|
||||
pragma Inline (Acts_As_Spec);
|
||||
pragma Inline (Actual_Designated_Subtype);
|
||||
pragma Inline (Aggregate_Bounds);
|
||||
pragma Inline (Aliased_Present);
|
||||
pragma Inline (All_Others);
|
||||
|
@ -8797,7 +8854,9 @@ package Sinfo is
|
|||
pragma Inline (Do_Storage_Check);
|
||||
pragma Inline (Do_Tag_Check);
|
||||
pragma Inline (Elaborate_Present);
|
||||
pragma Inline (Elaborate_All_Desirable);
|
||||
pragma Inline (Elaborate_All_Present);
|
||||
pragma Inline (Elaborate_Desirable);
|
||||
pragma Inline (Elaboration_Boolean);
|
||||
pragma Inline (Else_Actions);
|
||||
pragma Inline (Else_Statements);
|
||||
|
@ -8991,6 +9050,7 @@ package Sinfo is
|
|||
pragma Inline (Set_Actions);
|
||||
pragma Inline (Set_Activation_Chain_Entity);
|
||||
pragma Inline (Set_Acts_As_Spec);
|
||||
pragma Inline (Set_Actual_Designated_Subtype);
|
||||
pragma Inline (Set_Aggregate_Bounds);
|
||||
pragma Inline (Set_Aliased_Present);
|
||||
pragma Inline (Set_All_Others);
|
||||
|
@ -9065,7 +9125,9 @@ package Sinfo is
|
|||
pragma Inline (Set_Do_Storage_Check);
|
||||
pragma Inline (Set_Do_Tag_Check);
|
||||
pragma Inline (Set_Elaborate_Present);
|
||||
pragma Inline (Set_Elaborate_All_Desirable);
|
||||
pragma Inline (Set_Elaborate_All_Present);
|
||||
pragma Inline (Set_Elaborate_Desirable);
|
||||
pragma Inline (Set_Elaboration_Boolean);
|
||||
pragma Inline (Set_Else_Actions);
|
||||
pragma Inline (Set_Else_Statements);
|
||||
|
|
Loading…
Reference in New Issue