aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2015-05-22 14:50:35 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2015-05-22 14:50:35 +0200
commit57d22af251655cc429d5dec2f6234f33a3c2d8c9 (patch)
treee30d8fa127f2a8d0f8e2223bd9662d6dc7888059 /gcc
parent770551bc9337bddcb721f89a1d231d7afaf141ef (diff)
downloadgcc-57d22af251655cc429d5dec2f6234f33a3c2d8c9.zip
gcc-57d22af251655cc429d5dec2f6234f33a3c2d8c9.tar.gz
gcc-57d22af251655cc429d5dec2f6234f33a3c2d8c9.tar.bz2
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog31
-rw-r--r--gcc/ada/einfo.adb16
-rw-r--r--gcc/ada/einfo.ads10
-rw-r--r--gcc/ada/exp_ch4.adb171
-rw-r--r--gcc/ada/sem_ch10.adb15
-rw-r--r--gcc/ada/sem_ch13.adb11
-rw-r--r--gcc/ada/sprint.adb23
7 files changed, 200 insertions, 77 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb5f5e7..9c8ddbf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index bcbf20f..9b7cced 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.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 =>
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 550294f..76a8ff7 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c268968..9f3be7e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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);
-
- -- Create a new anonymous master when allocating an object of anonymous
- -- access-to-controlled type for the first time.
-
- if No (FM_Id) then
+ Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+ Unit_Id := Defining_Entity (Unit_Decl);
- -- Find the declarative list of the current unit
+ -- 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_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;
+ 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;
- -- Package or subprogram body
+ if Present (Anonymous_Master (Unit_Id)) then
+ return Anonymous_Master (Unit_Id);
- else
- Decls := Declarations (Unit_Decl);
-
- if No (Decls) then
- Decls := New_List;
- Set_Declarations (Unit_Decl, Decls);
- end if;
- end if;
+ -- Create a new anonymous master when allocating an object of anonymous
+ -- access-to-controlled type for the first time.
- 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;
--------------------------------
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 97933bb..5824154 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7f951bc..8a51383 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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;
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index bd772f3..9e3dca6 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -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;