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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145903 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c1c0391..20a79aa 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,12 @@
 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
 
 2009-04-10  Bob Duff  <duff@adacore.com>

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 851c4b3..2587dac 100644 (file)
--- 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 99d41f3..d589a60 100644 (file)
--- 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 0f854d5..5d43a14 100644 (file)
--- 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;