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

[multiple changes] 

2012-07-16  Vasiliy Fofanov  <fofanov@adacore.com>

	* ug_words, vms_data.ads: Document VMS qualifiers for -gnatn1/2
	switches.

2012-07-16  Bob Duff  <duff@adacore.com>

	* sinfo.ads: Minor comment fix.

2012-07-16  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Within_Elaborate_All): Walk the with clauses to
	find pragmas Elaborate_All that may be found in the transitive
	closure of the dependences.

From-SVN: r189517
This commit is contained in:
Arnaud Charlet 2012-07-16 12:52:21 +02:00
parent b3408631f7
commit f691d19f9e
5 changed files with 146 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
2012-07-16 Vasiliy Fofanov <fofanov@adacore.com>
* ug_words, vms_data.ads: Document VMS qualifiers for -gnatn1/2
switches.
2012-07-16 Bob Duff <duff@adacore.com>
* sinfo.ads: Minor comment fix.
2012-07-16 Bob Duff <duff@adacore.com>
* sem_elab.adb (Within_Elaborate_All): Walk the with clauses to
find pragmas Elaborate_All that may be found in the transitive
closure of the dependences.
2012-07-16 Robert Dewar <dewar@adacore.com>
* exp_pakd.adb, freeze.adb, sem_util.adb, vms_data.ads: Minor

156
gcc/ada/sem_elab.adb
View File

@ -325,11 +325,13 @@ package body Sem_Elab is
-- Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one
-- of its contained scopes, False otherwise.
function Within_Elaborate_All (E : Entity_Id) return Boolean;
-- Before emitting a warning on a scope E for a missing elaborate_all,
-- check whether E may be in the context of a directly visible unit U to
-- which the pragma applies. This prevents spurious warnings when the
-- called entity is renamed within U.
function Within_Elaborate_All
(Unit : Unit_Number_Type;
E : Entity_Id) return Boolean;
-- Return True if we are within the scope of an Elaborate_All for E, or if
-- we are within the scope of an Elaborate_All for some other unit U, and U
-- with's E. This prevents spurious warnings when the called entity is
-- renamed within U, or in case of generic instances.
--------------------------------------
-- Activate_Elaborate_All_Desirable --
@ -831,7 +833,7 @@ package body Sem_Elab is
end loop;
end if;
if Within_Elaborate_All (E_Scope) then
if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
return;
end if;
@ -1229,9 +1231,8 @@ package body Sem_Elab is
P := Parent (N);
while Present (P) loop
if Nkind (P) = N_Parameter_Specification
or else
Nkind (P) = N_Component_Declaration
if Nkind_In (P, N_Parameter_Specification,
N_Component_Declaration)
then
return;
@ -3282,46 +3283,121 @@ package body Sem_Elab is
-- Within_Elaborate_All --
--------------------------
function Within_Elaborate_All (E : Entity_Id) return Boolean is
Item : Node_Id;
Item2 : Node_Id;
Elab_Id : Entity_Id;
Par : Node_Id;
function Within_Elaborate_All
(Unit : Unit_Number_Type;
E : Entity_Id) return Boolean
is
type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
pragma Pack (Unit_Number_Set);
begin
Item := First (Context_Items (Cunit (Current_Sem_Unit)));
while Present (Item) loop
if Nkind (Item) = N_Pragma
and then Pragma_Name (Item) = Name_Elaborate_All
then
-- Return if some previous error on the pragma itself
Seen : Unit_Number_Set := (others => False);
-- Seen (X) is True after we have seen unit X in the walk. This is used
-- to prevent processing the same unit more than once.
if Error_Posted (Item) then
return False;
end if;
Result : Boolean := False;
Elab_Id :=
Entity
(Expression (First (Pragma_Argument_Associations (Item))));
procedure Helper (Unit : Unit_Number_Type);
-- This helper procedure does all the work for Within_Elaborate_All. It
-- walks the dependency graph, and sets Result to True if it finds an
-- appropriate Elaborate_All.
Par := Parent (Unit_Declaration_Node (Elab_Id));
------------
-- Helper --
------------
Item2 := First (Context_Items (Par));
while Present (Item2) loop
if Nkind (Item2) = N_With_Clause
and then Entity (Name (Item2)) = E
then
return True;
end if;
procedure Helper (Unit : Unit_Number_Type) is
CU : constant Node_Id := Cunit (Unit);
Next (Item2);
end loop;
Item : Node_Id;
Item2 : Node_Id;
Elab_Id : Entity_Id;
Par : Node_Id;
begin
if Seen (Unit) then
return;
else
Seen (Unit) := True;
end if;
Next (Item);
end loop;
-- First, check for Elaborate_Alls on this unit
return False;
Item := First (Context_Items (CU));
while Present (Item) loop
if Nkind (Item) = N_Pragma
and then Pragma_Name (Item) = Name_Elaborate_All
then
-- Return if some previous error on the pragma itself
if Error_Posted (Item) then
return;
end if;
Elab_Id :=
Entity
(Expression (First (Pragma_Argument_Associations (Item))));
if E = Elab_Id then
Result := True;
return;
end if;
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
and then not Limited_Present (Item2)
then
Result := True;
return;
end if;
Next (Item2);
end loop;
end if;
Next (Item);
end loop;
-- Second, recurse on with's. We could do this as part of the above
-- loop, but it's probably more efficient to have two loops, because
-- the relevant Elaborate_All is likely to be on the initial unit. In
-- other words, we're walking the with's breadth-first. This part is
-- only necessary in the dynamic elaboration model.
if Dynamic_Elaboration_Checks then
Item := First (Context_Items (CU));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then not Limited_Present (Item)
then
-- Note: the following call to Get_Cunit_Unit_Number does a
-- linear search, which could be slow, but it's OK because
-- we're about to give a warning anyway. Also, there might
-- be hundreds of units, but not millions. If it turns out
-- to be a problem, we could store the Get_Cunit_Unit_Number
-- 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)));
if Result then
return;
end if;
end if;
Next (Item);
end loop;
end if;
end Helper;
-- Start of processing for Within_Elaborate_All
begin
Helper (Unit);
return Result;
end Within_Elaborate_All;
end Sem_Elab;

11
gcc/ada/sinfo.ads
View File

@ -5796,9 +5796,11 @@ package Sinfo is
-- Unreferenced_In_Spec (Flag7-Sem)
-- No_Entities_Ref_In_Spec (Flag8-Sem)
-- Note: Limited_Present and Limited_View_Installed give support to
-- Ada 2005 (AI-50217).
-- Similarly, Private_Present gives support to AI-50262.
-- Note: Limited_Present and Limited_View_Installed are used to support
-- the implementation of Ada 2005 (AI-50217).
-- Similarly, Private_Present is used to support the implementation of
-- Ada 2005 (AI-50262).
----------------------
-- With_Type clause --
@ -5806,8 +5808,9 @@ package Sinfo is
-- This is a GNAT extension, used to implement mutually recursive
-- types declared in different packages.
-- Note: this is now obsolete. The functionality of this construct
-- is now implemented by the Ada 2005 Limited_with_Clause.
-- is now implemented by the Ada 2005 limited_with_clause.
---------------------
-- 10.2 Body stub --

2
gcc/ada/ug_words
View File

@ -84,6 +84,8 @@ gcc -c ^ GNAT COMPILE
-gnatm ^ /ERROR_LIMIT
-gnatm2 ^ /ERROR_LIMIT=2
-gnatn ^ /INLINE=PRAGMA
-gnatn1 ^ /INLINE=PRAGMA_LEVEL_1
-gnatn2 ^ /INLINE=PRAGMA_LEVEL_2
-gnatN ^ /INLINE=FULL
-gnato ^ /CHECKS=OVERFLOW
-gnatp ^ /CHECKS=SUPPRESS_ALL

7
gcc/ada/vms_data.ads
View File

@ -1826,8 +1826,13 @@ package VMS_Data is
-- (/OPTIMIZE=SOME) or higher (/OPTIMIZE=UNROLL_LOOPS)
-- levels of optimization.
--
-- PRAGMA_LEVEL_1/2 not documented ???
-- PRAGMA_LEVEL_1
-- Direct control of the level of "Inline" pragmas
-- optimization with moderate inlining across modules.
--
-- PRAGMA_LEVEL_2
-- Direct control of the level of "Inline" pragmas
-- optimization with full inlining across modules.
--
-- FULL Front end inlining. The front end inlining activated
-- by this switch is generally more extensive, and quite