Skip to content

R
riscv-gcc-1
Commit 58009744 by Arnaud Charlet
Options

[multiple changes] 

2015-03-04  Robert Dewar  <dewar@adacore.com>

	* einfo.adb (Is_ARECnF_Entity): Removed.
	(Last_Formal): Remove special handling of Is_ARECnF_Entity.
	(Next_Formal): Remove special handling of Is_ARECnF_Entity.
	(Next_Formal_With_Extras): Remove special handling of Is_ARECnF_Entity.
	(Number_Entries): Minor reformatting.
	* einfo.ads (Is_ARECnF_Entity): Removed.
	* exp_unst.adb (Unnest_Subprogram): Remove setting of
	Is_ARECnF_Entity.
	(Add_Extra_Formal): Use normal Extra_Formal circuit.
	* sprint.adb (Write_Param_Specs): Properly handle case where
	there are no source formals, but we have at least one Extra_Formal
	present.

2015-03-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate,
	Add_Discriminant_Values): If the value is a reference to the
	current instance of an enclosing type, use its base type to check
	against prefix of attribute reference, because the target type
	may be otherwise constrained.

From-SVN: r221187
parent e0601c0d
Showing with 106 additions and 120 deletions
gcc/ada/ChangeLog
2015-03-04 Robert Dewar <dewar@adacore.com>
* einfo.adb (Is_ARECnF_Entity): Removed.
(Last_Formal): Remove special handling of Is_ARECnF_Entity.
(Next_Formal): Remove special handling of Is_ARECnF_Entity.
(Next_Formal_With_Extras): Remove special handling of Is_ARECnF_Entity.
(Number_Entries): Minor reformatting.
* einfo.ads (Is_ARECnF_Entity): Removed.
* exp_unst.adb (Unnest_Subprogram): Remove setting of
Is_ARECnF_Entity.
(Add_Extra_Formal): Use normal Extra_Formal circuit.
* sprint.adb (Write_Param_Specs): Properly handle case where
there are no source formals, but we have at least one Extra_Formal
present.
2015-03-04 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Record_Aggregate,
Add_Discriminant_Values): If the value is a reference to the
current instance of an enclosing type, use its base type to check
against prefix of attribute reference, because the target type
may be otherwise constrained.
2015-03-04 Robert Dewar <dewar@adacore.com>
* atree.h: Add entries for Flag287-Flag309.
* einfo.adb: Add (unused) flags Flag287-Flag309.
......
gcc/ada/einfo.adb
......@@ -584,8 +584,8 @@ package body Einfo is
-- Is_Static_Type Flag281
-- Has_Nested_Subprogram Flag282
-- Uplevel_Reference_Noted Flag283
-- Is_ARECnF_Entity Flag284
-- (unused) Flag284
-- (unused) Flag285
-- (unused) Flag286
-- (unused) Flag287
......@@ -1915,11 +1915,6 @@ package body Einfo is
return Flag146 (Id);
end Is_Abstract_Type;
function Is_ARECnF_Entity (Id : E) return B is
begin
return Flag284 (Id);
end Is_ARECnF_Entity;
function Is_Local_Anonymous_Access (Id : E) return B is
begin
pragma Assert (Is_Access_Type (Id));
......@@ -4802,11 +4797,6 @@ package body Einfo is
Set_Flag146 (Id, V);
end Set_Is_Abstract_Type;
procedure Set_Is_ARECnF_Entity (Id : E; V : B := True) is
begin
Set_Flag284 (Id, V);
end Set_Is_ARECnF_Entity;
procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
begin
pragma Assert (Is_Access_Type (Id));
......@@ -7586,7 +7576,7 @@ package body Einfo is
function Last_Formal (Id : E) return E is
Formal : E;
NForm : E;
begin
pragma Assert
(Is_Overloadable (Id)
......@@ -7601,10 +7591,8 @@ package body Einfo is
Formal := First_Formal (Id);
if Present (Formal) then
loop
NForm := Next_Formal (Formal);
exit when No (NForm) or else Is_ARECnF_Entity (NForm);
Formal := NForm;
while Present (Next_Formal (Formal)) loop
Formal := Next_Formal (Formal);
end loop;
end if;
......@@ -7812,19 +7800,8 @@ package body Einfo is
loop
Next_Entity (P);
-- Return Empty if no next entity, or its an ARECnF entity (since
-- the latter is the last extra formal, not to be returned here).
if No (P) or else Is_ARECnF_Entity (P) then
return Empty;
-- If next entity is a formal, return it
elsif Is_Formal (P) then
if No (P) or else Is_Formal (P) then
return P;
-- Else one, unless we have an internal entity, which we skip
elsif not Is_Internal (P) then
return Empty;
end if;
......@@ -7836,30 +7813,11 @@ package body Einfo is
-----------------------------
function Next_Formal_With_Extras (Id : E) return E is
NForm : Entity_Id;
Next : Entity_Id;
begin
if Present (Extra_Formal (Id)) then
return Extra_Formal (Id);
else
NForm := Next_Formal (Id);
if Present (NForm) then
return NForm;
-- Deal with ARECnF entity as last extra formal
else
Next := Next_Entity (Id);
if Present (Next) and then Is_ARECnF_Entity (Next) then
return Next;
else
return Empty;
end if;
end if;
return Next_Formal (Id);
end if;
end Next_Formal_With_Extras;
......@@ -7922,8 +7880,8 @@ package body Einfo is
--------------------
function Number_Entries (Id : E) return Nat is
N : Int;
Ent : Entity_Id;
N : Int;
Ent : Entity_Id;
begin
pragma Assert (Is_Concurrent_Type (Id));
......@@ -8708,7 +8666,6 @@ package body Einfo is
W ("In_Use", Flag8 (Id));
W ("Is_Abstract_Subprogram", Flag19 (Id));
W ("Is_Abstract_Type", Flag146 (Id));
W ("Is_ARECnF_Entity", Flag284 (Id));
W ("Is_Access_Constant", Flag69 (Id));
W ("Is_Ada_2005_Only", Flag185 (Id));
W ("Is_Ada_2012_Only", Flag199 (Id));
......
gcc/ada/einfo.ads
......@@ -1214,10 +1214,12 @@ package Einfo is
-- Extra_Formal field (i.e. the Extra_Formal field of the last "real"
-- formal points to the first extra formal, and the Extra_Formal field of
-- each extra formal points to the next one, with Empty indicating the
-- end of the list of extra formals).
-- end of the list of extra formals). Another case of Extra_Formal arises
-- in connection with unnesting of subprograms, where the ARECnF formal
-- that represents an activation record pointer is an extra formal.
-- Extra_Formals (Node28)
-- Applies to subprograms and subprogram types, and also in entries
-- Applies to subprograms and subprogram types, and also to entries
-- and entry families. Returns first extra formal of the subprogram
-- or entry. Returns Empty if there are no extra formals.
......@@ -2176,15 +2178,6 @@ package Einfo is
-- carry the keyword aliased, and on record components that have the
-- keyword. For Ada 2012, also applies to formal parameters.
-- Is_ARECnF_Entity (Flag284)
-- Defined in all entities. Set for the ARECnF E_In_Parameter entity that
-- is generated for nested subprograms that require an activation record.
-- Logically this is an extra formal, and must be treated that way, but
-- we can't use the normal Extra_Formal mechanism since it is designed
-- to handle only cases where an extra formal is associated with one of
-- the source formals, which is not the case for ARECnF entities. Hence
-- we use this special flag to deal with this special extra formal.
-- Is_Atomic (Flag85)
-- Defined in all type entities, and also in constants, components and
-- variables. Set if a pragma Atomic or Shared applies to the entity.
......@@ -5257,7 +5250,6 @@ package Einfo is
-- In_Private_Part (Flag45)
-- Is_Ada_2005_Only (Flag185)
-- Is_Ada_2012_Only (Flag199)
-- Is_ARECnF_Entity (Flag284)
-- Is_Bit_Packed_Array (Flag122) (base type only)
-- Is_Aliased (Flag15)
-- Is_Character_Type (Flag63)
......@@ -6811,7 +6803,6 @@ package Einfo is
function Is_Ada_2005_Only (Id : E) return B;
function Is_Ada_2012_Only (Id : E) return B;
function Is_Aliased (Id : E) return B;
function Is_ARECnF_Entity (Id : E) return B;
function Is_Asynchronous (Id : E) return B;
function Is_Atomic (Id : E) return B;
function Is_Bit_Packed_Array (Id : E) return B;
......@@ -7460,7 +7451,6 @@ package Einfo is
procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
procedure Set_Is_Ada_2012_Only (Id : E; V : B := True);
procedure Set_Is_Aliased (Id : E; V : B := True);
procedure Set_Is_ARECnF_Entity (Id : E; V : B := True);
procedure Set_Is_Asynchronous (Id : E; V : B := True);
procedure Set_Is_Atomic (Id : E; V : B := True);
procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True);
......@@ -8228,7 +8218,6 @@ package Einfo is
pragma Inline (Is_Ada_2012_Only);
pragma Inline (Is_Aggregate_Type);
pragma Inline (Is_Aliased);
pragma Inline (Is_ARECnF_Entity);
pragma Inline (Is_Array_Type);
pragma Inline (Is_Assignable);
pragma Inline (Is_Asynchronous);
......@@ -8721,7 +8710,6 @@ package Einfo is
pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Is_Ada_2012_Only);
pragma Inline (Set_Is_Aliased);
pragma Inline (Set_Is_ARECnF_Entity);
pragma Inline (Set_Is_Asynchronous);
pragma Inline (Set_Is_Atomic);
pragma Inline (Set_Is_Bit_Packed_Array);
......
gcc/ada/exp_unst.adb
......@@ -611,7 +611,6 @@ package body Exp_Unst is
STJ.ARECnF :=
Make_Defining_Identifier (Loc,
Chars => Name_Find_Str (AREC_String (STJ.Lev - 1) & "F"));
Set_Is_ARECnF_Entity (STJ.ARECnF, True);
else
STJ.ARECnF := Empty;
end if;
......@@ -679,7 +678,7 @@ package body Exp_Unst is
-- and it is not obvious how we can get what we want if we
-- try to use the normal Analyze circuit.
Extra_Formal : declare
Add_Extra_Formal : declare
Encl : constant SI_Type := Enclosing_Subp (J);
STJE : Subp_Entry renames Subps.Table (Encl);
-- Index and Subp_Entry for enclosing routine
......@@ -688,12 +687,10 @@ package body Exp_Unst is
-- The formal to be added. Note that n here is one less
-- than the level of the subprogram itself (STJ.Ent).
Formb : Entity_Id;
-- If needed, this is the formal added to the body
procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id);
-- S is an N_Function/Procedure_Specification node, and F
-- is the new entity to add to this subprogramn spec.
-- is the new entity to add to this subprogramn spec as
-- the last Extra_Formal.
----------------------
-- Add_Form_To_Spec --
......@@ -701,43 +698,33 @@ package body Exp_Unst is
procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id) is
Sub : constant Entity_Id := Defining_Unit_Name (S);
Ent : Entity_Id;
begin
if No (First_Entity (Sub)) then
Set_First_Entity (Sub, F);
Set_Last_Entity (Sub, F);
-- Case of at least one Extra_Formal is present, set
-- ARECnF as the new last entry in the list.
if Present (Extra_Formals (Sub)) then
Ent := Extra_Formals (Sub);
while Present (Extra_Formal (Ent)) loop
Ent := Extra_Formal (Ent);
end loop;
Set_Extra_Formal (Ent, F);
-- No Extra formals present
else
declare
LastF : constant Entity_Id := Last_Formal (Sub);
begin
if No (LastF) then
Set_Next_Entity (F, First_Entity (Sub));
Set_First_Entity (Sub, F);
else
Set_Next_Entity (F, Next_Entity (LastF));
Set_Next_Entity (LastF, F);
if Last_Entity (Sub) = LastF then
Set_Last_Entity (Sub, F);
end if;
end if;
end;
end if;
Set_Extra_Formals (Sub, F);
Ent := Last_Formal (Sub);
if No (Parameter_Specifications (S)) then
Set_Parameter_Specifications (S, Empty_List);
if Present (Ent) then
Set_Extra_Formal (Ent, F);
end if;
end if;
Append_To (Parameter_Specifications (S),
Make_Parameter_Specification (Sloc (F),
Defining_Identifier => F,
Parameter_Type =>
New_Occurrence_Of (STJE.ARECnPT, Sloc (F))));
end Add_Form_To_Spec;
-- Start of processing for Extra_Formal
-- Start of processing for Add_Extra_Formal
begin
-- Decorate the new formal entity
......@@ -758,12 +745,9 @@ package body Exp_Unst is
-- Case of separate spec
else
Formb := New_Entity (Nkind (Form), Sloc (Form));
Copy_Node (Form, Formb);
Add_Form_To_Spec (Form, Parent (STJ.Ent));
Add_Form_To_Spec (Formb, Specification (STJ.Bod));
end if;
end Extra_Formal;
end Add_Extra_Formal;
end if;
-- Processing for subprograms that have at least one nested
......
gcc/ada/sprint.adb
......@@ -309,8 +309,9 @@ package body Sprint is
-- characters {} if the Do_Overflow flag is set on the node N.
procedure Write_Param_Specs (N : Node_Id);
-- Output parameter specifications for node (which is either a function
-- or procedure specification with a Parameter_Specifications field)
-- Output parameter specifications for node N (which is a subprogram, or
-- entry or entry family or access-subprogram-definition, all of which
-- have a Parameter_Specificatioons field).
procedure Write_Rewrite_Str (S : String);
-- Writes out a string (typically containing <<< or >>>}) for a node
......@@ -4554,17 +4555,25 @@ package body Sprint is
-----------------------
procedure Write_Param_Specs (N : Node_Id) is
Specs : List_Id;
Specs : constant List_Id := Parameter_Specifications (N);
Specs_Present : constant Boolean := Is_Non_Empty_List (Specs);
Ent : Entity_Id;
Extras : Node_Id;
Spec : Node_Id;
Formal : Node_Id;
Output : Boolean := False;
-- Set true if we output at least one parameter
begin
Specs := Parameter_Specifications (N);
-- Write out explicit specs from Parameter_Speficiations list
if Is_Non_Empty_List (Specs) then
if Specs_Present then
Write_Str_With_Col_Check (" (");
Spec := First (Specs);
Output := True;
Spec := First (Specs);
loop
Sprint_Node (Spec);
Formal := Defining_Identifier (Spec);
......@@ -4579,17 +4588,42 @@ package body Sprint is
Write_Str ("; ");
end if;
end loop;
end if;
-- Write out any extra formals
-- See if we have extra formals
while Present (Extra_Formal (Formal)) loop
Formal := Extra_Formal (Formal);
Write_Str ("; ");
Write_Name_With_Col_Check (Chars (Formal));
Write_Str (" : ");
Write_Name_With_Col_Check (Chars (Etype (Formal)));
end loop;
if Nkind_In (N, N_Function_Specification,
N_Procedure_Specification)
then
Ent := Defining_Entity (N);
-- Loop to write extra formals (if any)
if Present (Ent) and then Is_Subprogram (Ent) then
Extras := Extra_Formals (Ent);
if Present (Extras) then
if not Specs_Present then
Write_Str_With_Col_Check (" (");
Output := True;
end if;
Formal := Extras;
while Present (Formal) loop
if Specs_Present or else Formal /= Extras then
Write_Str ("; ");
end if;
Write_Name_With_Col_Check (Chars (Formal));
Write_Str (" : ");
Write_Name_With_Col_Check (Chars (Etype (Formal)));
Formal := Extra_Formal (Formal);
end loop;
end if;
end if;
end if;
if Output then
Write_Char (')');
end if;
end Write_Param_Specs;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment