einfo.ads, einfo.adb (Postcondition_Proc): New attribute for procedures.
2009-04-10 Robert Dewar <dewar@adacore.com> * einfo.ads, einfo.adb (Postcondition_Proc): New attribute for procedures. * sem_ch6.adb: Minor code clean up. From-SVN: r145903
This commit is contained in:
parent
362fcef348
commit
7ca78bba4d
|
@ -1,3 +1,10 @@
|
|||
2009-04-10 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* einfo.ads, einfo.adb (Postcondition_Proc): New attribute for
|
||||
procedures.
|
||||
|
||||
* sem_ch6.adb: Minor code clean up.
|
||||
|
||||
2009-04-10 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* mlib-tgt-specific-xi.adb: Minor reformatting
|
||||
|
|
|
@ -77,6 +77,7 @@ package body Einfo is
|
|||
-- Hiding_Loop_Variable Node8
|
||||
-- Mechanism Uint8 (but returns Mechanism_Type)
|
||||
-- Normalized_First_Bit Uint8
|
||||
-- Postcondition_Proc Node8
|
||||
-- Return_Applies_To Node8
|
||||
|
||||
-- Class_Wide_Type Node9
|
||||
|
@ -2355,6 +2356,12 @@ package body Einfo is
|
|||
return Node19 (Id);
|
||||
end Parent_Subtype;
|
||||
|
||||
function Postcondition_Proc (Id : E) return E is
|
||||
begin
|
||||
pragma Assert (Ekind (Id) = E_Procedure);
|
||||
return Node8 (Id);
|
||||
end Postcondition_Proc;
|
||||
|
||||
function Primitive_Operations (Id : E) return L is
|
||||
begin
|
||||
pragma Assert (Is_Tagged_Type (Id));
|
||||
|
@ -4824,6 +4831,12 @@ package body Einfo is
|
|||
Set_Node19 (Id, V);
|
||||
end Set_Parent_Subtype;
|
||||
|
||||
procedure Set_Postcondition_Proc (Id : E; V : E) is
|
||||
begin
|
||||
pragma Assert (Ekind (Id) = E_Procedure);
|
||||
Set_Node8 (Id, V);
|
||||
end Set_Postcondition_Proc;
|
||||
|
||||
procedure Set_Primitive_Operations (Id : E; V : L) is
|
||||
begin
|
||||
pragma Assert (Is_Tagged_Type (Id));
|
||||
|
@ -7175,6 +7188,9 @@ package body Einfo is
|
|||
when E_Package =>
|
||||
Write_Str ("Dependent_Instances");
|
||||
|
||||
when E_Procedure =>
|
||||
Write_Str ("Postcondition_Proc");
|
||||
|
||||
when E_Return_Statement =>
|
||||
Write_Str ("Return_Applies_To");
|
||||
|
||||
|
|
|
@ -3104,6 +3104,12 @@ package Einfo is
|
|||
-- Present in E_Record_Type. Points to the subtype to use for a
|
||||
-- field that references the parent record.
|
||||
|
||||
-- Postcondition_Proc (Node8)
|
||||
-- Present only in procedure entities, saves the entity of the generated
|
||||
-- postcondition proc if one is present, otherwise is set to Empty. Used
|
||||
-- to generate the call to this procedure in case the expander inserts
|
||||
-- implicit return statements.
|
||||
|
||||
-- Primitive_Operations (Elist15)
|
||||
-- Present in tagged record types and subtypes and in tagged private
|
||||
-- types. Points to an element list of entities for primitive operations
|
||||
|
@ -5139,6 +5145,7 @@ package Einfo is
|
|||
|
||||
-- E_Procedure
|
||||
-- E_Generic_Procedure
|
||||
-- Postcondition_Proc (Node8)
|
||||
-- Renaming_Map (Uint9)
|
||||
-- Handler_Records (List10) (non-generic case only)
|
||||
-- Protected_Body_Subprogram (Node11)
|
||||
|
@ -5923,6 +5930,7 @@ package Einfo is
|
|||
function Package_Instantiation (Id : E) return N;
|
||||
function Packed_Array_Type (Id : E) return E;
|
||||
function Parent_Subtype (Id : E) return E;
|
||||
function Postcondition_Proc (Id : E) return E;
|
||||
function Primitive_Operations (Id : E) return L;
|
||||
function Prival (Id : E) return E;
|
||||
function Prival_Link (Id : E) return E;
|
||||
|
@ -6473,6 +6481,7 @@ package Einfo is
|
|||
procedure Set_Package_Instantiation (Id : E; V : N);
|
||||
procedure Set_Packed_Array_Type (Id : E; V : E);
|
||||
procedure Set_Parent_Subtype (Id : E; V : E);
|
||||
procedure Set_Postcondition_Proc (Id : E; V : E);
|
||||
procedure Set_Primitive_Operations (Id : E; V : L);
|
||||
procedure Set_Prival (Id : E; V : E);
|
||||
procedure Set_Prival_Link (Id : E; V : E);
|
||||
|
@ -7164,6 +7173,7 @@ package Einfo is
|
|||
pragma Inline (Packed_Array_Type);
|
||||
pragma Inline (Parameter_Mode);
|
||||
pragma Inline (Parent_Subtype);
|
||||
pragma Inline (Postcondition_Proc);
|
||||
pragma Inline (Primitive_Operations);
|
||||
pragma Inline (Prival);
|
||||
pragma Inline (Prival_Link);
|
||||
|
@ -7548,6 +7558,7 @@ package Einfo is
|
|||
pragma Inline (Set_Package_Instantiation);
|
||||
pragma Inline (Set_Packed_Array_Type);
|
||||
pragma Inline (Set_Parent_Subtype);
|
||||
pragma Inline (Set_Postcondition_Proc);
|
||||
pragma Inline (Set_Primitive_Operations);
|
||||
pragma Inline (Set_Prival);
|
||||
pragma Inline (Set_Prival_Link);
|
||||
|
|
|
@ -1933,6 +1933,8 @@ package body Sem_Ch6 is
|
|||
Set_Convention (Spec_Id, Convention_Protected);
|
||||
end;
|
||||
|
||||
-- Case where a separate spec is present
|
||||
|
||||
elsif Present (Spec_Id) then
|
||||
Spec_Decl := Unit_Declaration_Node (Spec_Id);
|
||||
Verify_Overriding_Indicator;
|
||||
|
@ -1958,8 +1960,19 @@ package body Sem_Ch6 is
|
|||
Set_Has_Delayed_Freeze (Spec_Id);
|
||||
Insert_Actions (N, Freeze_Entity (Spec_Id, Loc));
|
||||
end if;
|
||||
|
||||
-- The missing else branch here is for the case where there is no
|
||||
-- separate spec and either we don't have a protected operation, or the
|
||||
-- node is compiler generated. Is it really right that nothing needs to
|
||||
-- be done in this case. At the very least a comment is appropriate as
|
||||
-- to why nothing needs to be done in this case ???
|
||||
|
||||
else
|
||||
null;
|
||||
end if;
|
||||
|
||||
-- Mark presence of postcondition proc in current scope
|
||||
|
||||
if Chars (Body_Id) = Name_uPostconditions then
|
||||
Set_Has_Postconditions (Current_Scope);
|
||||
end if;
|
||||
|
|
Loading…
Reference in New Issue