[multiple changes]

2013-07-08  Gary Dismukes  <dismukes@adacore.com>

	* gnat_rm.texi: Minor reformatting and rewording for consistency.

2013-07-08  Bob Duff  <duff@adacore.com>

	* exp_ch3.adb (Build_Master): If Desig_Type is an incomplete
	view coming from a limited-with'ed package, use the nonlimited
	view in case it has tasks.

2013-07-08  Javier Miranda  <miranda@adacore.com>

	* sem_ch8.ad[sb] (Save_Scope_Stack): Modified to return the list
	of entities which have been temporarily removed from immediate
	visibility.
	(Restore_Scope_Stack): Modified to receive an
	additional parameter with the list of entities whose immediate
	visibility must be restored.
	* sem.adb (Do_Analyze): Use new version of
	Save_Scope_Stack/Restore_Scope_Stack
	* sem_ch12.adb (Inline_Instance_Body): Use new version of
	Save_Scope_Stack and Restore_Scope_Stack

From-SVN: r200754
This commit is contained in:
Arnaud Charlet 2013-07-08 09:44:01 +02:00
parent a9e892d075
commit e530a2d13b
7 changed files with 85 additions and 128 deletions

View file

@ -1,3 +1,26 @@
2013-07-08 Gary Dismukes <dismukes@adacore.com>
* gnat_rm.texi: Minor reformatting and rewording for consistency.
2013-07-08 Bob Duff <duff@adacore.com>
* exp_ch3.adb (Build_Master): If Desig_Type is an incomplete
view coming from a limited-with'ed package, use the nonlimited
view in case it has tasks.
2013-07-08 Javier Miranda <miranda@adacore.com>
* sem_ch8.ad[sb] (Save_Scope_Stack): Modified to return the list
of entities which have been temporarily removed from immediate
visibility.
(Restore_Scope_Stack): Modified to receive an
additional parameter with the list of entities whose immediate
visibility must be restored.
* sem.adb (Do_Analyze): Use new version of
Save_Scope_Stack/Restore_Scope_Stack
* sem_ch12.adb (Inline_Instance_Body): Use new version of
Save_Scope_Stack and Restore_Scope_Stack
2013-07-08 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Remove

View file

@ -4632,9 +4632,19 @@ package body Exp_Ch3 is
------------------
procedure Build_Master (Ptr_Typ : Entity_Id) is
Desig_Typ : constant Entity_Id := Designated_Type (Ptr_Typ);
Desig_Typ : Entity_Id := Designated_Type (Ptr_Typ);
begin
-- If the designated type is an incomplete view coming from a
-- limited-with'ed package, we need to use the nonlimited view in
-- case it has tasks.
if Ekind (Desig_Typ) in Incomplete_Kind
and then Present (Non_Limited_View (Desig_Typ))
then
Desig_Typ := Non_Limited_View (Desig_Typ);
end if;
-- Anonymous access types are created for the components of the
-- record parameter for an entry declaration. No master is created
-- for such a type.

View file

@ -6052,20 +6052,20 @@ by other pragmas) of a package declaration, it marks the whole package
@item
When the pragma appears at the start of the private declarations of a
package (only other pragmas can appear between the @code{private} keyword
and the @code{SPARK_Mode} pragma, it marks the private part in or
out of SPARK 2014 (overriding the mode for the public part).
and the @code{SPARK_Mode} pragma), it marks the private part in or
out of SPARK 2014 (overriding the default mode of the visible part).
@item
When the pragma appears immediately at the start of the declarations of a
package body (preceded only by other pragmas),
it marks the whole body in or out of SPARK 2014 (overriding the default
mode copied from the declaration).
mode set by the declaration).
@item
When the pragma appears at the start of the elaboration statements of
a package body (only other pragmas can appear between the @code{begin}
keyword and the @code{SPARK_Mode} pragma,
it marks the elaboration statements in or out of SPARK 2014, overriding
keyword and the @code{SPARK_Mode} pragma),
it marks the elaboration statements in or out of SPARK 2014 (overriding
the default mode of the package body).
@item
@ -6076,7 +6076,7 @@ subprogram (spec and body) in or out of SPARK 2014.
@item
When the pragma appears at the start of the declarations of a subprogram
body (preceded only by other pragmas), it marks the whole body in or out
of SPARK 2014, overriding the default mode set by the declaration.
of SPARK 2014 (overriding the default mode set by the declaration).
@item
Any other use of the pragma is illegal.

View file

@ -1340,8 +1340,10 @@ package body Sem is
----------------
procedure Do_Analyze is
List : Elist_Id;
begin
Save_Scope_Stack;
List := Save_Scope_Stack;
Push_Scope (Standard_Standard);
Scope_Suppress := Suppress_Options;
Scope_Stack.Table
@ -1362,7 +1364,7 @@ package body Sem is
-- Then pop entry for Standard, and pop implicit types
Pop_Scope;
Restore_Scope_Stack;
Restore_Scope_Stack (List);
end Do_Analyze;
Already_Analyzed : constant Boolean := Analyzed (Comp_Unit);

View file

@ -4084,6 +4084,7 @@ package body Sem_Ch12 is
Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id;
Instances : array (1 .. Scope_Stack_Depth) of Entity_Id;
Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id;
List : Elist_Id;
Num_Inner : Int := 0;
N_Instances : Int := 0;
S : Entity_Id;
@ -4187,7 +4188,7 @@ package body Sem_Ch12 is
-- Remove entities in current scopes from visibility, so that
-- instance body is compiled in a clean environment.
Save_Scope_Stack (Handle_Use => False);
List := Save_Scope_Stack (Handle_Use => False);
if Is_Child_Unit (S) then
@ -4261,7 +4262,7 @@ package body Sem_Ch12 is
end loop;
end if;
Restore_Scope_Stack (Handle_Use => False);
Restore_Scope_Stack (List, Handle_Use => False);
if Present (Curr_Scope)
and then

View file

@ -7654,119 +7654,20 @@ package body Sem_Ch8 is
-- Restore_Scope_Stack --
-------------------------
procedure Restore_Scope_Stack (Handle_Use : Boolean := True) is
E : Entity_Id;
S : Entity_Id;
Comp_Unit : Node_Id;
In_Child : Boolean := False;
Full_Vis : Boolean := True;
SS_Last : constant Int := Scope_Stack.Last;
procedure Restore_Scope_Stack
(List : Elist_Id;
Handle_Use : Boolean := True)
is
SS_Last : constant Int := Scope_Stack.Last;
Elmt : Elmt_Id;
begin
-- Restore visibility of previous scope stack, if any
for J in reverse 0 .. Scope_Stack.Last loop
exit when Scope_Stack.Table (J).Entity = Standard_Standard
or else No (Scope_Stack.Table (J).Entity);
S := Scope_Stack.Table (J).Entity;
if not Is_Hidden_Open_Scope (S) then
-- If the parent scope is hidden, its entities are hidden as
-- well, unless the entity is the instantiation currently
-- being analyzed.
if not Is_Hidden_Open_Scope (Scope (S))
or else not Analyzed (Parent (S))
or else Scope (S) = Standard_Standard
then
Set_Is_Immediately_Visible (S, True);
end if;
E := First_Entity (S);
while Present (E) loop
if Is_Child_Unit (E) then
if not From_With_Type (E) then
Set_Is_Immediately_Visible (E,
Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
else
pragma Assert
(Nkind (Parent (E)) = N_Defining_Program_Unit_Name
and then
Nkind (Parent (Parent (E))) =
N_Package_Specification);
Set_Is_Immediately_Visible (E,
Limited_View_Installed (Parent (Parent (E))));
end if;
else
Set_Is_Immediately_Visible (E, True);
end if;
Next_Entity (E);
if not Full_Vis and then Is_Package_Or_Generic_Package (S) then
-- We are in the visible part of the package scope
exit when E = First_Private_Entity (S);
end if;
end loop;
-- The visibility of child units (siblings of current compilation)
-- must be restored in any case. Their declarations may appear
-- after the private part of the parent.
if not Full_Vis then
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
end if;
Next_Entity (E);
end loop;
end if;
end if;
if Is_Child_Unit (S)
and not In_Child -- check only for current unit
then
In_Child := True;
-- Restore visibility of parents according to whether the child
-- is private and whether we are in its visible part.
Comp_Unit := Parent (Unit_Declaration_Node (S));
if Nkind (Comp_Unit) = N_Compilation_Unit
and then Private_Present (Comp_Unit)
then
Full_Vis := True;
elsif Is_Package_Or_Generic_Package (S)
and then (In_Private_Part (S) or else In_Package_Body (S))
then
Full_Vis := True;
-- if S is the scope of some instance (which has already been
-- seen on the stack) it does not affect the visibility of
-- other scopes.
elsif Is_Hidden_Open_Scope (S) then
null;
elsif Ekind_In (S, E_Procedure, E_Function)
and then Has_Completion (S)
then
Full_Vis := True;
else
Full_Vis := False;
end if;
else
Full_Vis := True;
end if;
Elmt := First_Elmt (List);
while Present (Elmt) loop
Set_Is_Immediately_Visible (Node (Elmt));
Next_Elmt (Elmt);
end loop;
if SS_Last >= Scope_Stack.First
@ -7781,11 +7682,24 @@ package body Sem_Ch8 is
-- Save_Scope_Stack --
----------------------
procedure Save_Scope_Stack (Handle_Use : Boolean := True) is
function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id is
Result : constant Elist_Id := New_Elmt_List;
E : Entity_Id;
S : Entity_Id;
SS_Last : constant Int := Scope_Stack.Last;
procedure Remove_From_Visibility (E : Entity_Id);
-- If E is immediately visible then append it to the result and remove
-- it temporarily from visibility
procedure Remove_From_Visibility (E : Entity_Id) is
begin
if Is_Immediately_Visible (E) then
Append_Elmt (E, Result);
Set_Is_Immediately_Visible (E, False);
end if;
end Remove_From_Visibility;
begin
if SS_Last >= Scope_Stack.First
and then Scope_Stack.Table (SS_Last).Entity /= Standard_Standard
@ -7803,16 +7717,19 @@ package body Sem_Ch8 is
or else No (Scope_Stack.Table (J).Entity);
S := Scope_Stack.Table (J).Entity;
Set_Is_Immediately_Visible (S, False);
Remove_From_Visibility (S);
E := First_Entity (S);
while Present (E) loop
Set_Is_Immediately_Visible (E, False);
Remove_From_Visibility (E);
Next_Entity (E);
end loop;
end loop;
end if;
return Result;
end Save_Scope_Stack;
-------------

View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -148,9 +148,11 @@ package Sem_Ch8 is
-- with-clause on system. N is absent when the function is called to find
-- the visibility of implicit operators.
procedure Restore_Scope_Stack (Handle_Use : Boolean := True);
procedure Save_Scope_Stack (Handle_Use : Boolean := True);
-- These two procedures are called from Semantics, when a unit U1 is to
function Save_Scope_Stack (Handle_Use : Boolean := True) return Elist_Id;
procedure Restore_Scope_Stack
(List : Elist_Id;
Handle_Use : Boolean := True);
-- These two subprograms are called from Semantics, when a unit U1 is to
-- be compiled in the course of the compilation of another unit U2. This
-- happens whenever Rtsfind is called. U1, the unit retrieved by Rtsfind,
-- must be compiled in its own context, and the current scope stack
@ -159,7 +161,9 @@ package Sem_Ch8 is
-- Handle_Use indicates whether local use clauses must be removed or
-- installed. In the case of inlining of instance bodies, the visibility
-- handling is done fully in Inline_Instance_Body, and use clauses are
-- handled there.
-- handled there. Save_Scope_Stack returns the list of entities which have
-- been temporarily removed from visibility; that list must be passed to
-- Restore_Scope_Stack to restore their visibility.
procedure Set_Use (L : List_Id);
-- Find use clauses that are declarative items in a package declaration