mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-18 07:20:25 +08:00
[multiple changes]
2015-05-22 Eric Botcazou <ebotcazou@adacore.com> * sprint.adb (Source_Dump): When generating debug files, deal with the case of a stand-alone package instantiation by dumping together the spec and the body in the common debug file. 2015-05-22 Robert Dewar <dewar@adacore.com> * sem_ch13.adb (Minimum_Size): Size is zero for null range discrete subtype. 2015-05-22 Hristian Kirtchev <kirtchev@adacore.com> * einfo.adb (Anonymous_Master): This attribute now applies to package and subprogram bodies. (Set_Anonymous_Master): This attribute now applies to package and subprogram bodies. (Write_Field36_Name): Add output for package and subprogram bodies. * einfo.ads Update the documentation on attribute Anonymous_Master along with occurrences in entities. * exp_ch4.adb (Create_Anonymous_Master): Reimplemented to handle spec and body anonymous masters of the same unit. (Current_Anonymous_Master): Reimplemented. Handle a package instantiation that acts as a compilation unit. (Insert_And_Analyze): Reimplemented. 2015-05-22 Ed Schonberg <schonberg@adacore.com> * sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a predefined unit is treated as a regular with_clause. From-SVN: r223557
This commit is contained in:
parent
770551bc93
commit
57d22af251
@ -1,3 +1,34 @@
|
||||
2015-05-22 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sprint.adb (Source_Dump): When generating debug files, deal
|
||||
with the case of a stand-alone package instantiation by dumping
|
||||
together the spec and the body in the common debug file.
|
||||
|
||||
2015-05-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Minimum_Size): Size is zero for null range
|
||||
discrete subtype.
|
||||
|
||||
2015-05-22 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* einfo.adb (Anonymous_Master): This attribute now applies
|
||||
to package and subprogram bodies.
|
||||
(Set_Anonymous_Master): This attribute now applies to package and
|
||||
subprogram bodies.
|
||||
(Write_Field36_Name): Add output for package and subprogram bodies.
|
||||
* einfo.ads Update the documentation on attribute Anonymous_Master
|
||||
along with occurrences in entities.
|
||||
* exp_ch4.adb (Create_Anonymous_Master): Reimplemented to
|
||||
handle spec and body anonymous masters of the same unit.
|
||||
(Current_Anonymous_Master): Reimplemented. Handle a
|
||||
package instantiation that acts as a compilation unit.
|
||||
(Insert_And_Analyze): Reimplemented.
|
||||
|
||||
2015-05-22 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a
|
||||
predefined unit is treated as a regular with_clause.
|
||||
|
||||
2015-05-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb,
|
||||
|
@ -757,7 +757,11 @@ package body Einfo is
|
||||
|
||||
function Anonymous_Master (Id : E) return E is
|
||||
begin
|
||||
pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
|
||||
pragma Assert (Ekind_In (Id, E_Function,
|
||||
E_Package,
|
||||
E_Package_Body,
|
||||
E_Procedure,
|
||||
E_Subprogram_Body));
|
||||
return Node36 (Id);
|
||||
end Anonymous_Master;
|
||||
|
||||
@ -3586,7 +3590,11 @@ package body Einfo is
|
||||
|
||||
procedure Set_Anonymous_Master (Id : E; V : E) is
|
||||
begin
|
||||
pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
|
||||
pragma Assert (Ekind_In (Id, E_Function,
|
||||
E_Package,
|
||||
E_Package_Body,
|
||||
E_Procedure,
|
||||
E_Subprogram_Body));
|
||||
Set_Node36 (Id, V);
|
||||
end Set_Anonymous_Master;
|
||||
|
||||
@ -10141,7 +10149,9 @@ package body Einfo is
|
||||
when E_Function |
|
||||
E_Operator |
|
||||
E_Package |
|
||||
E_Procedure =>
|
||||
E_Package_Body |
|
||||
E_Procedure |
|
||||
E_Subprogram_Body =>
|
||||
Write_Str ("Anonymous_Master");
|
||||
|
||||
when others =>
|
||||
|
@ -437,10 +437,10 @@ package Einfo is
|
||||
-- into an attribute definition clause for this purpose.
|
||||
|
||||
-- Anonymous_Master (Node36)
|
||||
-- Defined in the entities of non-generic subprogram and package units.
|
||||
-- Contains the entity of a special heterogeneous finalization master
|
||||
-- that services most anonymous access-to-controlled allocations that
|
||||
-- occur within the unit.
|
||||
-- Defined in the entities of non-generic packages, subprograms and their
|
||||
-- corresponding bodies. Contains the entity of a special heterogeneous
|
||||
-- finalization master that services most anonymous access-to-controlled
|
||||
-- allocations that occur within the unit.
|
||||
|
||||
-- Associated_Entity (Node37)
|
||||
-- Defined in all entities. This field is similar to Associated_Node, but
|
||||
@ -6096,6 +6096,7 @@ package Einfo is
|
||||
-- SPARK_Pragma (Node32)
|
||||
-- SPARK_Aux_Pragma (Node33)
|
||||
-- Contract (Node34)
|
||||
-- Anonymous_Master (Node36)
|
||||
-- Contains_Ignored_Ghost_Code (Flag279)
|
||||
-- Delay_Subprogram_Descriptors (Flag50)
|
||||
-- SPARK_Aux_Pragma_Inherited (Flag266)
|
||||
@ -6320,6 +6321,7 @@ package Einfo is
|
||||
-- Extra_Formals (Node28)
|
||||
-- SPARK_Pragma (Node32)
|
||||
-- Contract (Node34)
|
||||
-- Anonymous_Master (Node36)
|
||||
-- Contains_Ignored_Ghost_Code (Flag279)
|
||||
-- SPARK_Pragma_Inherited (Flag265)
|
||||
-- Scope_Depth (synth)
|
||||
|
@ -416,82 +416,134 @@ package body Exp_Ch4 is
|
||||
|
||||
function Current_Anonymous_Master return Entity_Id is
|
||||
function Create_Anonymous_Master
|
||||
(Unit_Id : Entity_Id;
|
||||
Decls : List_Id) return Entity_Id;
|
||||
-- Create a new anonymous finalization master for a unit denoted by
|
||||
-- Unit_Id. The declaration of the master along with any specialized
|
||||
-- initialization is inserted at the top of declarative list Decls.
|
||||
-- Return the entity of the anonymous master.
|
||||
(Unit_Id : Entity_Id;
|
||||
Unit_Decl : Node_Id) return Entity_Id;
|
||||
-- Create a new anonymous master for a compilation unit denoted by its
|
||||
-- entity Unit_Id and declaration Unit_Decl. The declaration of the new
|
||||
-- master along with any specialized initialization is inserted at the
|
||||
-- top of the unit's declarations (see body for special cases). Return
|
||||
-- the entity of the anonymous master.
|
||||
|
||||
-----------------------------
|
||||
-- Create_Anonymous_Master --
|
||||
-----------------------------
|
||||
|
||||
function Create_Anonymous_Master
|
||||
(Unit_Id : Entity_Id;
|
||||
Decls : List_Id) return Entity_Id
|
||||
(Unit_Id : Entity_Id;
|
||||
Unit_Decl : Node_Id) return Entity_Id
|
||||
is
|
||||
First_Decl : Node_Id := Empty;
|
||||
-- The first declaration of list Decls. This variable is used when
|
||||
-- inserting various actions.
|
||||
Insert_Nod : Node_Id := Empty;
|
||||
-- The point of insertion into the declarative list of the unit. All
|
||||
-- nodes are inserted before Insert_Nod.
|
||||
|
||||
procedure Insert_And_Analyze (Action : Node_Id);
|
||||
-- Insert arbitrary node Action in declarative list Decl and analyze
|
||||
-- it.
|
||||
procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id);
|
||||
-- Insert arbitrary node N in declarative list Decls and analyze it
|
||||
|
||||
------------------------
|
||||
-- Insert_And_Analyze --
|
||||
------------------------
|
||||
|
||||
procedure Insert_And_Analyze (Action : Node_Id) is
|
||||
procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id) is
|
||||
begin
|
||||
-- The list is already populated, the actions are inserted at the
|
||||
-- top of the list, preserving their order.
|
||||
-- The declarative list is already populated, the nodes are
|
||||
-- inserted at the top of the list, preserving their order.
|
||||
|
||||
if Present (First_Decl) then
|
||||
Insert_Before_And_Analyze (First_Decl, Action);
|
||||
if Present (Insert_Nod) then
|
||||
Insert_Before (Insert_Nod, N);
|
||||
|
||||
-- Otherwise append to the declarations to preserve order
|
||||
|
||||
else
|
||||
Append_To (Decls, Action);
|
||||
Analyze (Action);
|
||||
Append_To (Decls, N);
|
||||
end if;
|
||||
|
||||
Analyze (N);
|
||||
end Insert_And_Analyze;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Loc : constant Source_Ptr := Sloc (Unit_Id);
|
||||
FM_Id : Entity_Id;
|
||||
Loc : constant Source_Ptr := Sloc (Unit_Id);
|
||||
Spec_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl);
|
||||
Decls : List_Id;
|
||||
FM_Id : Entity_Id;
|
||||
Pref : Character;
|
||||
Unit_Spec : Node_Id;
|
||||
|
||||
-- Start of processing for Create_Anonymous_Master
|
||||
|
||||
begin
|
||||
if Present (Decls) then
|
||||
First_Decl := First (Decls);
|
||||
-- Find the declarative list of the unit
|
||||
|
||||
if Nkind (Unit_Decl) = N_Package_Declaration then
|
||||
Unit_Spec := Specification (Unit_Decl);
|
||||
Decls := Visible_Declarations (Unit_Spec);
|
||||
|
||||
if No (Decls) then
|
||||
Decls := New_List (Make_Null_Statement (Loc));
|
||||
Set_Visible_Declarations (Unit_Spec, Decls);
|
||||
end if;
|
||||
|
||||
-- Package or subprogram body
|
||||
|
||||
-- ??? A subprogram declaration that acts as a compilation unit may
|
||||
-- contain a formal parameter of an anonymous access-to-controlled
|
||||
-- type initialized by an allocator.
|
||||
|
||||
-- procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
|
||||
|
||||
-- There is no suitable place to create the anonymous master as the
|
||||
-- subprogram is not in a declarative list.
|
||||
|
||||
else
|
||||
Decls := Declarations (Unit_Decl);
|
||||
|
||||
if No (Decls) then
|
||||
Decls := New_List (Make_Null_Statement (Loc));
|
||||
Set_Declarations (Unit_Decl, Decls);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- The anonymous master and all initialization actions are inserted
|
||||
-- before the first declaration (if any).
|
||||
|
||||
Insert_Nod := First (Decls);
|
||||
|
||||
-- Since the anonymous master and all its initialization actions are
|
||||
-- inserted at top level, use the scope of the unit when analyzing.
|
||||
|
||||
Push_Scope (Unit_Id);
|
||||
Push_Scope (Spec_Id);
|
||||
|
||||
-- Create the anonymous master
|
||||
-- Step 1: Anonymous master creation
|
||||
|
||||
-- Use a unique prefix in case the same unit requires two anonymous
|
||||
-- masters, one for the spec (S) and one for the body (B).
|
||||
|
||||
if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
|
||||
Pref := 'S';
|
||||
else
|
||||
Pref := 'B';
|
||||
end if;
|
||||
|
||||
FM_Id :=
|
||||
Make_Defining_Identifier (Loc,
|
||||
Chars => New_External_Name (Chars (Unit_Id), "AM"));
|
||||
New_External_Name
|
||||
(Related_Id => Chars (Unit_Id),
|
||||
Suffix => "AM",
|
||||
Prefix => Pref));
|
||||
|
||||
Set_Anonymous_Master (Unit_Id, FM_Id);
|
||||
|
||||
-- Generate:
|
||||
-- <FM_Id> : Finalization_Master;
|
||||
|
||||
Insert_And_Analyze
|
||||
(Make_Object_Declaration (Loc,
|
||||
Insert_And_Analyze (Decls,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => FM_Id,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
|
||||
|
||||
-- Step 2: Initialization actions
|
||||
|
||||
-- Do not set the base pool and mode of operation on .NET/JVM since
|
||||
-- those targets do not support pools and all VM masters defaulted to
|
||||
-- heterogeneous.
|
||||
@ -502,8 +554,8 @@ package body Exp_Ch4 is
|
||||
-- Set_Base_Pool
|
||||
-- (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
|
||||
|
||||
Insert_And_Analyze
|
||||
(Make_Procedure_Call_Statement (Loc,
|
||||
Insert_And_Analyze (Decls,
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
@ -516,8 +568,8 @@ package body Exp_Ch4 is
|
||||
-- Generate:
|
||||
-- Set_Is_Heterogeneous (<FM_Id>);
|
||||
|
||||
Insert_And_Analyze
|
||||
(Make_Procedure_Call_Statement (Loc,
|
||||
Insert_And_Analyze (Decls,
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
@ -530,48 +582,35 @@ package body Exp_Ch4 is
|
||||
|
||||
-- Local declarations
|
||||
|
||||
Unit_Decl : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
|
||||
Unit_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl);
|
||||
Decls : List_Id;
|
||||
FM_Id : Entity_Id;
|
||||
Unit_Spec : Node_Id;
|
||||
Unit_Decl : Node_Id;
|
||||
Unit_Id : Entity_Id;
|
||||
|
||||
-- Start of processing for Current_Anonymous_Master
|
||||
|
||||
begin
|
||||
FM_Id := Anonymous_Master (Unit_Id);
|
||||
Unit_Decl := Unit (Cunit (Current_Sem_Unit));
|
||||
Unit_Id := Defining_Entity (Unit_Decl);
|
||||
|
||||
-- The compilation unit is a package instantiation. In this case the
|
||||
-- anonymous master is associated with the package spec as both the
|
||||
-- spec and body appear at the same level.
|
||||
|
||||
if Nkind (Unit_Decl) = N_Package_Body
|
||||
and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
|
||||
then
|
||||
Unit_Id := Corresponding_Spec (Unit_Decl);
|
||||
Unit_Decl := Unit_Declaration_Node (Unit_Id);
|
||||
end if;
|
||||
|
||||
if Present (Anonymous_Master (Unit_Id)) then
|
||||
return Anonymous_Master (Unit_Id);
|
||||
|
||||
-- Create a new anonymous master when allocating an object of anonymous
|
||||
-- access-to-controlled type for the first time.
|
||||
|
||||
if No (FM_Id) then
|
||||
|
||||
-- Find the declarative list of the current unit
|
||||
|
||||
if Nkind (Unit_Decl) = N_Package_Declaration then
|
||||
Unit_Spec := Specification (Unit_Decl);
|
||||
Decls := Visible_Declarations (Unit_Spec);
|
||||
|
||||
if No (Decls) then
|
||||
Decls := New_List;
|
||||
Set_Visible_Declarations (Unit_Spec, Decls);
|
||||
end if;
|
||||
|
||||
-- Package or subprogram body
|
||||
|
||||
else
|
||||
Decls := Declarations (Unit_Decl);
|
||||
|
||||
if No (Decls) then
|
||||
Decls := New_List;
|
||||
Set_Declarations (Unit_Decl, Decls);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
FM_Id := Create_Anonymous_Master (Unit_Id, Decls);
|
||||
else
|
||||
return Create_Anonymous_Master (Unit_Id, Unit_Decl);
|
||||
end if;
|
||||
|
||||
return FM_Id;
|
||||
end Current_Anonymous_Master;
|
||||
|
||||
--------------------------------
|
||||
|
@ -2551,8 +2551,21 @@ package body Sem_Ch10 is
|
||||
-- Ada 2005 (AI-50217): Build visibility structures but do not
|
||||
-- analyze the unit.
|
||||
|
||||
-- If the designated unit is a predefined unit, which might be used
|
||||
-- implicitly through the rtsfind machinery, a limited with clause
|
||||
-- on such a unit is usually pointless, because run-time units are
|
||||
-- unlikely to appear in mutually dependent units, and because this
|
||||
-- disables the rtsfind mechanism. We transform such limited with
|
||||
-- clauses into regular with clauses.
|
||||
|
||||
if Sloc (U) /= No_Location then
|
||||
Build_Limited_Views (N);
|
||||
if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (U)))
|
||||
then
|
||||
Set_Limited_Present (N, False);
|
||||
Analyze_With_Clause (N);
|
||||
else
|
||||
Build_Limited_Views (N);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return;
|
||||
|
@ -11718,11 +11718,20 @@ package body Sem_Ch13 is
|
||||
Lo := Uint_0;
|
||||
end if;
|
||||
|
||||
-- Null range case, size is always zero. We only do this in the discrete
|
||||
-- type case, since that's the odd case that came up. Probably we should
|
||||
-- also do this in the fixed-point case, but doing so causes peculiar
|
||||
-- gigi failures, and it is not worth worrying about this incredibly
|
||||
-- marginal case (explicit null-range fixed-point type declarations)???
|
||||
|
||||
if Lo > Hi and then Is_Discrete_Type (T) then
|
||||
S := 0;
|
||||
|
||||
-- Signed case. Note that we consider types like range 1 .. -1 to be
|
||||
-- signed for the purpose of computing the size, since the bounds have
|
||||
-- to be accommodated in the base type.
|
||||
|
||||
if Lo < 0 or else Hi < 0 then
|
||||
elsif Lo < 0 or else Hi < 0 then
|
||||
S := 1;
|
||||
B := Uint_1;
|
||||
|
||||
|
@ -624,11 +624,16 @@ package body Sprint is
|
||||
for U in Main_Unit .. Last_Unit loop
|
||||
Current_Source_File := Source_Index (U);
|
||||
|
||||
-- Dump all units if -gnatdf set, otherwise we dump only
|
||||
-- the source files that are in the extended main source.
|
||||
-- Dump all units if -gnatdf set, otherwise dump only the source
|
||||
-- files that are in the extended main source. Note that, if we
|
||||
-- are generating debug files, generating that of the main unit
|
||||
-- has an effect on the outcome of In_Extended_Main_Source_Unit
|
||||
-- because slocs are rewritten, so we also test for equality of
|
||||
-- Cunit_Entity to work around this effect.
|
||||
|
||||
if Debug_Flag_F
|
||||
or else In_Extended_Main_Source_Unit (Cunit_Entity (U))
|
||||
or else Cunit_Entity (U) = Cunit_Entity (Main_Unit)
|
||||
then
|
||||
-- If we are generating debug files, setup to write them
|
||||
|
||||
@ -638,6 +643,20 @@ package body Sprint is
|
||||
First_Debug_Sloc := Debug_Sloc;
|
||||
Write_Source_Line (1);
|
||||
Last_Line_Printed := 1;
|
||||
|
||||
-- If this unit has the same entity as the main unit, for
|
||||
-- example is the spec of a stand-alone instantiation of
|
||||
-- a package and the main unit is the body, its debug file
|
||||
-- will also be the same. Therefore, we need to print again
|
||||
-- the main unit to have both units in the debug file.
|
||||
|
||||
if U /= Main_Unit
|
||||
and then Cunit_Entity (U) = Cunit_Entity (Main_Unit)
|
||||
then
|
||||
Sprint_Node (Cunit (Main_Unit));
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
Sprint_Node (Cunit (U));
|
||||
Write_Source_Lines (Last_Source_Line (Current_Source_File));
|
||||
Write_Eol;
|
||||
|
Loading…
x
Reference in New Issue
Block a user