[multiple changes]
[gcc.git] / gcc / ada / sinfo.adb
index a453e12f125306724eeee4a0f6d9682c8c2d8b10..136195ee33ab4d60f15be8443d477187763c5432 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -148,6 +148,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_And_Then
         or else NT (N).Nkind = N_Case_Expression_Alternative
         or else NT (N).Nkind = N_Compilation_Unit_Aux
+        or else NT (N).Nkind = N_Compound_Statement
         or else NT (N).Nkind = N_Expression_With_Actions
         or else NT (N).Nkind = N_Freeze_Entity
         or else NT (N).Nkind = N_Or_Else);
@@ -431,6 +432,14 @@ package body Sinfo is
       return Node3 (N);
    end Classifications;
 
+   function Cleanup_Actions
+     (N : Node_Id) return List_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      return List5 (N);
+   end Cleanup_Actions;
+
    function Comes_From_Extended_Return_Statement
      (N : Node_Id) return Boolean is
    begin
@@ -930,8 +939,10 @@ package body Sinfo is
       (N : Node_Id) return Boolean is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Selected_Component);
-      return Flag13 (N);
+        or else NT (N).Nkind = N_Assignment_Statement
+        or else NT (N).Nkind = N_Selected_Component
+        or else NT (N).Nkind = N_Type_Conversion);
+      return Flag1 (N);
    end Do_Discriminant_Check;
 
    function Do_Division_Check
@@ -1030,15 +1041,6 @@ package body Sinfo is
       return Flag4 (N);
    end Elaborate_Present;
 
-   function Elaboration_Boolean
-      (N : Node_Id) return Node_Id is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Specification
-        or else NT (N).Nkind = N_Procedure_Specification);
-      return Node2 (N);
-   end Elaboration_Boolean;
-
    function Else_Actions
       (N : Node_Id) return List_Id is
    begin
@@ -1104,7 +1106,8 @@ package body Sinfo is
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Aspect_Specification
         or else NT (N).Nkind = N_Attribute_Definition_Clause
-        or else NT (N).Nkind = N_Freeze_Entity);
+        or else NT (N).Nkind = N_Freeze_Entity
+        or else NT (N).Nkind = N_Freeze_Generic_Entity);
       return Node4 (N);
    end Entity;
 
@@ -1388,6 +1391,15 @@ package body Sinfo is
       return Flag4 (N);
    end From_At_Mod;
 
+   function From_Conditional_Expression
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Statement
+        or else NT (N).Nkind = N_If_Statement);
+      return Flag1 (N);
+   end From_Conditional_Expression;
+
    function From_Default
       (N : Node_Id) return Boolean is
    begin
@@ -1396,6 +1408,14 @@ package body Sinfo is
       return Flag6 (N);
    end From_Default;
 
+   function Generalized_Indexing
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Indexed_Component);
+      return Node4 (N);
+   end Generalized_Indexing;
+
    function Generic_Associations
       (N : Node_Id) return List_Id is
    begin
@@ -1624,8 +1644,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Enumeration_Representation_Clause
         or else NT (N).Nkind = N_Label
         or else NT (N).Nkind = N_Loop_Statement
-        or else NT (N).Nkind = N_Record_Representation_Clause
-        or else NT (N).Nkind = N_Subprogram_Info);
+        or else NT (N).Nkind = N_Record_Representation_Clause);
       return Node1 (N);
    end Identifier;
 
@@ -1677,14 +1696,6 @@ package body Sinfo is
       return Flag16 (N);
    end Import_Interface_Present;
 
-   function In_Assertion_Expression
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Call);
-      return Flag4 (N);
-   end In_Assertion_Expression;
-
    function In_Present
       (N : Node_Id) return Boolean is
    begin
@@ -1702,6 +1713,14 @@ package body Sinfo is
       return Flag11 (N);
    end Includes_Infinities;
 
+   function Incomplete_View
+     (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Full_Type_Declaration);
+      return Node2 (N);
+   end Incomplete_View;
+
    function Inherited_Discriminant
       (N : Node_Id) return Boolean is
    begin
@@ -1853,6 +1872,14 @@ package body Sinfo is
       return Flag4 (N);
    end Is_Folded_In_Parser;
 
+   function Is_Generic_Contract_Pragma
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag2 (N);
+   end Is_Generic_Contract_Pragma;
+
    function Is_Ignored
       (N : Node_Id) return Boolean is
    begin
@@ -1870,6 +1897,14 @@ package body Sinfo is
       return Flag11 (N);
    end Is_In_Discriminant_Check;
 
+   function Is_Inherited
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag4 (N);
+   end Is_Inherited;
+
    function Is_Machine_Number
       (N : Node_Id) return Boolean is
    begin
@@ -2336,6 +2371,14 @@ package body Sinfo is
       return Flag17 (N);
    end No_Truncation;
 
+   function Non_Aliased_Prefix
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Attribute_Reference);
+      return Flag18 (N);
+   end Non_Aliased_Prefix;
+
    function Null_Present
       (N : Node_Id) return Boolean is
    begin
@@ -2346,6 +2389,14 @@ package body Sinfo is
       return Flag13 (N);
    end Null_Present;
 
+   function Null_Excluding_Subtype
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Access_To_Object_Definition);
+      return Flag16 (N);
+   end Null_Excluding_Subtype;
+
    function Null_Exclusion_Present
       (N : Node_Id) return Boolean is
    begin
@@ -2444,15 +2495,6 @@ package body Sinfo is
       return List3 (N);
    end Parameter_Associations;
 
-   function Parameter_List_Truncated
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Call
-        or else NT (N).Nkind = N_Procedure_Call_Statement);
-      return Flag17 (N);
-   end Parameter_List_Truncated;
-
    function Parameter_Specifications
       (N : Node_Id) return List_Id is
    begin
@@ -3120,6 +3162,22 @@ package body Sinfo is
       return Node3 (N);
    end Type_Definition;
 
+   function Uneval_Old_Accept
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag7 (N);
+   end Uneval_Old_Accept;
+
+   function Uneval_Old_Warn
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag18 (N);
+   end Uneval_Old_Warn;
+
    function Unit
       (N : Node_Id) return Node_Id is
    begin
@@ -3173,6 +3231,15 @@ package body Sinfo is
       return List2 (N);
    end Visible_Declarations;
 
+   function Uninitialized_Variable
+     (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration);
+      return Node3 (N);
+   end Uninitialized_Variable;
+
    function Used_Operations
      (N : Node_Id) return Elist_Id is
    begin
@@ -3295,6 +3362,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_And_Then
         or else NT (N).Nkind = N_Case_Expression_Alternative
         or else NT (N).Nkind = N_Compilation_Unit_Aux
+        or else NT (N).Nkind = N_Compound_Statement
         or else NT (N).Nkind = N_Expression_With_Actions
         or else NT (N).Nkind = N_Freeze_Entity
         or else NT (N).Nkind = N_Or_Else);
@@ -3578,6 +3646,14 @@ package body Sinfo is
       Set_Node3 (N, Val); -- semantic field, no parent set
    end Set_Classifications;
 
+   procedure Set_Cleanup_Actions
+      (N : Node_Id; Val : List_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      Set_List5 (N, Val); -- semantic field, no parent set
+   end Set_Cleanup_Actions;
+
    procedure Set_Comes_From_Extended_Return_Statement
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4077,8 +4153,10 @@ package body Sinfo is
       (N : Node_Id; Val : Boolean := True) is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Selected_Component);
-      Set_Flag13 (N, Val);
+        or else NT (N).Nkind = N_Assignment_Statement
+        or else NT (N).Nkind = N_Selected_Component
+        or else NT (N).Nkind = N_Type_Conversion);
+      Set_Flag1 (N, Val);
    end Set_Do_Discriminant_Check;
 
    procedure Set_Do_Division_Check
@@ -4177,21 +4255,12 @@ package body Sinfo is
       Set_Flag4 (N, Val);
    end Set_Elaborate_Present;
 
-   procedure Set_Elaboration_Boolean
-      (N : Node_Id; Val : Node_Id) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Specification
-        or else NT (N).Nkind = N_Procedure_Specification);
-      Set_Node2 (N, Val);
-   end Set_Elaboration_Boolean;
-
    procedure Set_Else_Actions
       (N : Node_Id; Val : List_Id) is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_If_Expression);
-      Set_List3 (N, Val); -- semantic field, no parent set
+      Set_List3_With_Parent (N, Val); -- semantic field, but needs parents
    end Set_Else_Actions;
 
    procedure Set_Else_Statements
@@ -4251,7 +4320,8 @@ package body Sinfo is
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Aspect_Specification
         or else NT (N).Nkind = N_Attribute_Definition_Clause
-        or else NT (N).Nkind = N_Freeze_Entity);
+        or else NT (N).Nkind = N_Freeze_Entity
+        or else NT (N).Nkind = N_Freeze_Generic_Entity);
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_Entity;
 
@@ -4526,6 +4596,15 @@ package body Sinfo is
       Set_Flag4 (N, Val);
    end Set_From_At_Mod;
 
+   procedure Set_From_Conditional_Expression
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Statement
+        or else NT (N).Nkind = N_If_Statement);
+      Set_Flag1 (N, Val);
+   end Set_From_Conditional_Expression;
+
    procedure Set_From_Default
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4534,6 +4613,14 @@ package body Sinfo is
       Set_Flag6 (N, Val);
    end Set_From_Default;
 
+   procedure Set_Generalized_Indexing
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Indexed_Component);
+      Set_Node4 (N, Val);
+   end Set_Generalized_Indexing;
+
    procedure Set_Generic_Associations
       (N : Node_Id; Val : List_Id) is
    begin
@@ -4762,8 +4849,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Enumeration_Representation_Clause
         or else NT (N).Nkind = N_Label
         or else NT (N).Nkind = N_Loop_Statement
-        or else NT (N).Nkind = N_Record_Representation_Clause
-        or else NT (N).Nkind = N_Subprogram_Info);
+        or else NT (N).Nkind = N_Record_Representation_Clause);
       Set_Node1_With_Parent (N, Val);
    end Set_Identifier;
 
@@ -4815,14 +4901,6 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Import_Interface_Present;
 
-   procedure Set_In_Assertion_Expression
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Call);
-      Set_Flag4 (N, Val);
-   end Set_In_Assertion_Expression;
-
    procedure Set_In_Present
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4840,6 +4918,14 @@ package body Sinfo is
       Set_Flag11 (N, Val);
    end Set_Includes_Infinities;
 
+   procedure Set_Incomplete_View
+     (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Full_Type_Declaration);
+      Set_Node2 (N, Val); --  semantic field, no Parent set
+   end Set_Incomplete_View;
+
    procedure Set_Inherited_Discriminant
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4991,6 +5077,14 @@ package body Sinfo is
       Set_Flag4 (N, Val);
    end Set_Is_Folded_In_Parser;
 
+   procedure Set_Is_Generic_Contract_Pragma
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag2 (N, Val);
+   end Set_Is_Generic_Contract_Pragma;
+
    procedure Set_Is_Ignored
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5008,6 +5102,14 @@ package body Sinfo is
       Set_Flag11 (N, Val);
    end Set_Is_In_Discriminant_Check;
 
+   procedure Set_Is_Inherited
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag4 (N, Val);
+   end Set_Is_Inherited;
+
    procedure Set_Is_Machine_Number
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5474,6 +5576,14 @@ package body Sinfo is
       Set_Flag17 (N, Val);
    end Set_No_Truncation;
 
+   procedure Set_Non_Aliased_Prefix
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Attribute_Reference);
+      Set_Flag18 (N, Val);
+   end Set_Non_Aliased_Prefix;
+
    procedure Set_Null_Present
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5484,6 +5594,14 @@ package body Sinfo is
       Set_Flag13 (N, Val);
    end Set_Null_Present;
 
+   procedure Set_Null_Excluding_Subtype
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Access_To_Object_Definition);
+      Set_Flag16 (N, Val);
+   end Set_Null_Excluding_Subtype;
+
    procedure Set_Null_Exclusion_Present
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5582,15 +5700,6 @@ package body Sinfo is
       Set_List3_With_Parent (N, Val);
    end Set_Parameter_Associations;
 
-   procedure Set_Parameter_List_Truncated
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Function_Call
-        or else NT (N).Nkind = N_Procedure_Call_Statement);
-      Set_Flag17 (N, Val);
-   end Set_Parameter_List_Truncated;
-
    procedure Set_Parameter_Specifications
       (N : Node_Id; Val : List_Id) is
    begin
@@ -6203,7 +6312,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_If_Expression);
-      Set_List2 (N, Val); -- semantic field, no parent set
+      Set_List2_With_Parent (N, Val); -- semantic field, but needs parents
    end Set_Then_Actions;
 
    procedure Set_Then_Statements
@@ -6250,6 +6359,22 @@ package body Sinfo is
       Set_Elist3 (N, Val); -- semantic field, no parent set
    end Set_TSS_Elist;
 
+   procedure Set_Uneval_Old_Accept
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag7 (N, Val);
+   end Set_Uneval_Old_Accept;
+
+   procedure Set_Uneval_Old_Warn
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag18 (N, Val);
+   end Set_Uneval_Old_Warn;
+
    procedure Set_Type_Definition
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -6311,6 +6436,15 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Visible_Declarations;
 
+   procedure Set_Uninitialized_Variable
+     (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration);
+      Set_Node3 (N, Val);
+   end Set_Uninitialized_Variable;
+
    procedure Set_Used_Operations
      (N : Node_Id; Val :  Elist_Id) is
    begin