From: Robert Dewar Date: Fri, 10 Apr 2009 13:44:18 +0000 (+0000) Subject: einfo.ads, einfo.adb (Postcondition_Proc): New attribute for procedures. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7ca78bba4d3036c0a7257fcebc7c5ba79ad0dcad;p=gcc.git einfo.ads, einfo.adb (Postcondition_Proc): New attribute for procedures. 2009-04-10 Robert Dewar * einfo.ads, einfo.adb (Postcondition_Proc): New attribute for procedures. * sem_ch6.adb: Minor code clean up. From-SVN: r145903 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c1c0391320e..20a79aaa881 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2009-04-10 Robert Dewar + + * einfo.ads, einfo.adb (Postcondition_Proc): New attribute for + procedures. + + * sem_ch6.adb: Minor code clean up. + 2009-04-10 Robert Dewar * mlib-tgt-specific-xi.adb: Minor reformatting diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 851c4b3c148..2587dac63f9 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 99d41f35ca2..d589a60e6d1 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 0f854d5ee65..5d43a14c5df 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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;