diff options
-rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
-rw-r--r-- | gcc/ada/atree.adb | 31 | ||||
-rw-r--r-- | gcc/ada/atree.ads | 18 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 381 | ||||
-rw-r--r-- | gcc/ada/layout.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 1 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 16 | ||||
-rw-r--r-- | gcc/ada/switch-c.ads | 1 |
10 files changed, 222 insertions, 257 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a7f5008..da0a9db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,24 @@ 2010-06-17 Robert Dewar <dewar@adacore.com> + * switch-c.ads, switch-c.adb, sem_ch13.adb: Minor reformatting. + * sem_ch12.adb: Add pragmas Assert and Check to previous change. + +2010-06-17 Gary Dismukes <dismukes@adacore.com> + + * layout.adb (Layout_Type): Broaden test for setting an array type's + Component_Size to include all scalar types, not just discrete types + (components of real types were missed). + * sem_ch3.adb (Constrain_Index): Add missing setting of First_Literal + on the itype created for an index (consistent with Make_Index and + avoids possible Assert_Failures). + +2010-06-17 Robert Dewar <dewar@adacore.com> + + * atree.ads, atree.adb: Add 6-parameter version of Ekind_In + * einfo.adb: Minor code reformatting (use Ekind_In) + +2010-06-17 Robert Dewar <dewar@adacore.com> + * sem_warn.adb (Test_Ref): Abandon scan if access subprogram parameter found. diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index de7bd7e..2a8b221 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -823,6 +823,24 @@ package body Atree is end Ekind_In; function Ekind_In + (T : Entity_Kind; + V1 : Entity_Kind; + V2 : Entity_Kind; + V3 : Entity_Kind; + V4 : Entity_Kind; + V5 : Entity_Kind; + V6 : Entity_Kind) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4 or else + T = V5 or else + T = V6; + end Ekind_In; + + function Ekind_In (E : Entity_Id; V1 : Entity_Kind; V2 : Entity_Kind) return Boolean @@ -864,6 +882,19 @@ package body Atree is return Ekind_In (Ekind (E), V1, V2, V3, V4, V5); end Ekind_In; + function Ekind_In + (E : Entity_Id; + V1 : Entity_Kind; + V2 : Entity_Kind; + V3 : Entity_Kind; + V4 : Entity_Kind; + V5 : Entity_Kind; + V6 : Entity_Kind) return Boolean + is + begin + return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6); + end Ekind_In; + ------------------ -- Error_Posted -- ------------------ diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 2f61374..7408b0e 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -657,6 +657,15 @@ package Atree is V5 : Entity_Kind) return Boolean; function Ekind_In + (E : Entity_Id; + V1 : Entity_Kind; + V2 : Entity_Kind; + V3 : Entity_Kind; + V4 : Entity_Kind; + V5 : Entity_Kind; + V6 : Entity_Kind) return Boolean; + + function Ekind_In (T : Entity_Kind; V1 : Entity_Kind; V2 : Entity_Kind) return Boolean; @@ -682,6 +691,15 @@ package Atree is V4 : Entity_Kind; V5 : Entity_Kind) return Boolean; + function Ekind_In + (T : Entity_Kind; + V1 : Entity_Kind; + V2 : Entity_Kind; + V3 : Entity_Kind; + V4 : Entity_Kind; + V5 : Entity_Kind; + V6 : Entity_Kind) return Boolean; + pragma Inline (Ekind_In); -- Inline all above functions diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 1fd68b8..c3edd69 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -559,9 +559,7 @@ package body Einfo is function Actual_Subtype (Id : E) return E is begin pragma Assert - (Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable - or else Ekind (Id) = E_Generic_In_Out_Parameter + (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter) or else Is_Formal (Id)); return Node17 (Id); end Actual_Subtype; @@ -582,10 +580,10 @@ package body Einfo is begin pragma Assert (Is_Type (Id) or else Is_Formal (Id) - or else Ekind (Id) = E_Loop_Parameter - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Exception - or else Ekind (Id) = E_Variable); + or else Ekind_In (Id, E_Loop_Parameter, + E_Constant, + E_Exception, + E_Variable)); return Uint14 (Id); end Alignment; @@ -626,8 +624,7 @@ package body Einfo is function Body_Entity (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)); return Node19 (Id); end Body_Entity; @@ -664,24 +661,19 @@ package body Einfo is function Cloned_Subtype (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Record_Subtype - or else - Ekind (Id) = E_Class_Wide_Subtype); + pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype)); return Node16 (Id); end Cloned_Subtype; function Component_Bit_Offset (Id : E) return U is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); return Uint11 (Id); end Component_Bit_Offset; function Component_Clause (Id : E) return N is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); return Node13 (Id); end Component_Clause; @@ -875,17 +867,14 @@ package body Einfo is function DT_Position (Id : E) return U is begin - pragma Assert - ((Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure) - and then Present (DTC_Entity (Id))); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure) + and then Present (DTC_Entity (Id))); return Uint15 (Id); end DT_Position; function DTC_Entity (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Node16 (Id); end DTC_Entity; @@ -986,11 +975,11 @@ package body Einfo is function Equivalent_Type (Id : E) return E is begin pragma Assert - (Ekind (Id) = E_Class_Wide_Subtype or else - Ekind (Id) = E_Access_Protected_Subprogram_Type or else - Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else - Ekind (Id) = E_Access_Subprogram_Type or else - Ekind (Id) = E_Exception_Type); + (Ekind_In (Id, E_Class_Wide_Subtype, + E_Access_Protected_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type, + E_Access_Subprogram_Type, + E_Exception_Type)); return Node18 (Id); end Equivalent_Type; @@ -1026,9 +1015,9 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Subprogram_Body - or else Ekind (Id) = E_Subprogram_Type); + or else Ekind_In (Id, E_Entry_Family, + E_Subprogram_Body, + E_Subprogram_Type)); return Node28 (Id); end Extra_Formals; @@ -1074,15 +1063,13 @@ package body Einfo is function First_Optional_Parameter (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Node14 (Id); end First_Optional_Parameter; function First_Private_Entity (Id : E) return E is begin - pragma Assert (Ekind (Id) = E_Package - or else Ekind (Id) = E_Generic_Package + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package) or else Ekind (Id) in Concurrent_Kind); return Node16 (Id); end First_Private_Entity; @@ -1278,8 +1265,7 @@ package body Einfo is function Has_Missing_Return (Id : E) return B is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function); + pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function)); return Flag142 (Id); end Has_Missing_Return; @@ -1499,9 +1485,7 @@ package body Einfo is function Has_Up_Level_Access (Id : E) return B is begin pragma Assert - (Ekind (Id) = E_Variable - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Loop_Parameter); + (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter)); return Flag215 (Id); end Has_Up_Level_Access; @@ -1528,9 +1512,7 @@ package body Einfo is function Implemented_By_Entry (Id : E) return B is begin - pragma Assert - (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Flag232 (Id); end Implemented_By_Entry; @@ -1615,8 +1597,7 @@ package body Einfo is function Is_Asynchronous (Id : E) return B is begin - pragma Assert - (Ekind (Id) = E_Procedure or else Is_Type (Id)); + pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id)); return Flag81 (Id); end Is_Asynchronous; @@ -1632,8 +1613,7 @@ package body Einfo is function Is_Called (Id : E) return B is begin - pragma Assert - (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function); + pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); return Flag102 (Id); end Is_Called; @@ -1744,10 +1724,7 @@ package body Einfo is function Is_For_Access_Subtype (Id : E) return B is begin - pragma Assert - (Ekind (Id) = E_Record_Subtype - or else - Ekind (Id) = E_Private_Subtype); + pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype)); return Flag118 (Id); end Is_For_Access_Subtype; @@ -1937,15 +1914,13 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Generic_Function - or else Ekind (Id) = E_Generic_Procedure); + or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure)); return Flag218 (Id); end Is_Primitive; function Is_Primitive_Wrapper (Id : E) return B is begin - pragma Assert (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Flag195 (Id); end Is_Primitive_Wrapper; @@ -1962,8 +1937,7 @@ package body Einfo is function Is_Private_Primitive (Id : E) return B is begin - pragma Assert (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Flag245 (Id); end Is_Private_Primitive; @@ -2231,8 +2205,7 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Subprogram_Type - or else Ekind (Id) = E_Entry_Family); + or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family)); return Flag22 (Id); end Needs_No_Actuals; @@ -2283,22 +2256,19 @@ package body Einfo is function Normalized_First_Bit (Id : E) return U is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); return Uint8 (Id); end Normalized_First_Bit; function Normalized_Position (Id : E) return U is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); return Uint14 (Id); end Normalized_Position; function Normalized_Position_Max (Id : E) return U is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); return Uint10 (Id); end Normalized_Position_Max; @@ -2317,18 +2287,14 @@ package body Einfo is function Optimize_Alignment_Space (Id : E) return B is begin pragma Assert - (Is_Type (Id) - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable)); return Flag241 (Id); end Optimize_Alignment_Space; function Optimize_Alignment_Time (Id : E) return B is begin pragma Assert - (Is_Type (Id) - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable)); return Flag242 (Id); end Optimize_Alignment_Time; @@ -2340,10 +2306,7 @@ package body Einfo is function Original_Record_Component (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Void - or else Ekind (Id) = E_Component - or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant)); return Node22 (Id); end Original_Record_Component; @@ -2359,10 +2322,7 @@ package body Einfo is function Package_Instantiation (Id : E) return N is begin - pragma Assert - (False - or else Ekind (Id) = E_Generic_Package - or else Ekind (Id) = E_Package); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)); return Node26 (Id); end Package_Instantiation; @@ -2398,8 +2358,7 @@ package body Einfo is function Prival_Link (Id : E) return E is begin - pragma Assert (Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); return Node20 (Id); end Prival_Link; @@ -2429,10 +2388,8 @@ package body Einfo is function Protection_Object (Id : E) return E is begin - pragma Assert (Ekind (Id) = E_Entry - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert + (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure)); return Node23 (Id); end Protection_Object; @@ -2476,21 +2433,19 @@ package body Einfo is function Related_Expression (Id : E) return N is begin - pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable); + pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); return Node24 (Id); end Related_Expression; function Related_Instance (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body); + pragma Assert (Ekind_In (Id, E_Package, E_Package_Body)); return Node15 (Id); end Related_Instance; function Related_Type (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Constant); + pragma Assert (Ekind_In (Id, E_Component, E_Constant)); return Node26 (Id); end Related_Type; @@ -2576,8 +2531,7 @@ package body Einfo is function Shadow_Entities (Id : E) return S is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)); return List14 (Id); end Shadow_Entities; @@ -2589,7 +2543,7 @@ package body Einfo is function Size_Check_Code (Id : E) return N is begin - pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable); + pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); return Node19 (Id); end Size_Check_Code; @@ -2611,8 +2565,7 @@ package body Einfo is function Spec_Entity (Id : E) return E is begin - pragma Assert - (Ekind (Id) = E_Package_Body or else Is_Formal (Id)); + pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id)); return Node19 (Id); end Spec_Entity; @@ -2753,9 +2706,8 @@ package body Einfo is function Wrapped_Entity (Id : E) return E is begin - pragma Assert ((Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure) - and then Is_Primitive_Wrapper (Id)); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure) + and then Is_Primitive_Wrapper (Id)); return Node27 (Id); end Wrapped_Entity; @@ -2963,8 +2915,7 @@ package body Einfo is function Is_Signed_Integer_Type (Id : E) return B is begin - return Ekind (Id) in - Signed_Integer_Kind; + return Ekind (Id) in Signed_Integer_Kind; end Is_Signed_Integer_Type; function Is_Subprogram (Id : E) return B is @@ -3022,9 +2973,7 @@ package body Einfo is procedure Set_Actual_Subtype (Id : E; V : E) is begin pragma Assert - (Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable - or else Ekind (Id) = E_Generic_In_Out_Parameter + (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter) or else Is_Formal (Id)); Set_Node17 (Id, V); end Set_Actual_Subtype; @@ -3044,11 +2993,11 @@ package body Einfo is procedure Set_Alignment (Id : E; V : U) is begin pragma Assert (Is_Type (Id) - or else Is_Formal (Id) - or else Ekind (Id) = E_Loop_Parameter - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Exception - or else Ekind (Id) = E_Variable); + or else Is_Formal (Id) + or else Ekind_In (Id, E_Loop_Parameter, + E_Constant, + E_Exception, + E_Variable)); Set_Uint14 (Id, V); end Set_Alignment; @@ -3066,8 +3015,7 @@ package body Einfo is procedure Set_Body_Entity (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)); Set_Node19 (Id, V); end Set_Body_Entity; @@ -3075,8 +3023,8 @@ package body Einfo is begin pragma Assert (Ekind (Id) = E_Package - or else Is_Subprogram (Id) - or else Is_Generic_Unit (Id)); + or else Is_Subprogram (Id) + or else Is_Generic_Unit (Id)); Set_Flag40 (Id, V); end Set_Body_Needed_For_SAL; @@ -3104,23 +3052,19 @@ package body Einfo is procedure Set_Cloned_Subtype (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Record_Subtype - or else Ekind (Id) = E_Class_Wide_Subtype); + pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype)); Set_Node16 (Id, V); end Set_Cloned_Subtype; procedure Set_Component_Bit_Offset (Id : E; V : U) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); Set_Uint11 (Id, V); end Set_Component_Bit_Offset; procedure Set_Component_Clause (Id : E; V : N) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); Set_Node13 (Id, V); end Set_Component_Clause; @@ -3225,9 +3169,7 @@ package body Einfo is procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is begin pragma Assert - (Is_Subprogram (Id) - or else Ekind (Id) = E_Package - or else Ekind (Id) = E_Package_Body); + (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body)); Set_Flag50 (Id, V); end Set_Delay_Subprogram_Descriptors; @@ -3320,14 +3262,13 @@ package body Einfo is procedure Set_DT_Position (Id : E; V : U) is begin - pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Uint15 (Id, V); end Set_DT_Position; procedure Set_DTC_Entity (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Node16 (Id, V); end Set_DTC_Entity; @@ -3428,12 +3369,12 @@ package body Einfo is procedure Set_Equivalent_Type (Id : E; V : E) is begin pragma Assert - (Ekind (Id) = E_Class_Wide_Type or else - Ekind (Id) = E_Class_Wide_Subtype or else - Ekind (Id) = E_Access_Protected_Subprogram_Type or else - Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else - Ekind (Id) = E_Access_Subprogram_Type or else - Ekind (Id) = E_Exception_Type); + (Ekind_In (Id, E_Class_Wide_Type, + E_Class_Wide_Subtype, + E_Access_Protected_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type, + E_Access_Subprogram_Type, + E_Exception_Type)); Set_Node18 (Id, V); end Set_Equivalent_Type; @@ -3469,9 +3410,9 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Subprogram_Body - or else Ekind (Id) = E_Subprogram_Type); + or else Ekind_In (Id, E_Entry_Family, + E_Subprogram_Body, + E_Subprogram_Type)); Set_Node28 (Id, V); end Set_Extra_Formals; @@ -3519,16 +3460,14 @@ package body Einfo is procedure Set_First_Optional_Parameter (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Node14 (Id, V); end Set_First_Optional_Parameter; procedure Set_First_Private_Entity (Id : E; V : E) is begin - pragma Assert (Ekind (Id) = E_Package - or else Ekind (Id) = E_Generic_Package - or else Ekind (Id) in Concurrent_Kind); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package) + or else Ekind (Id) in Concurrent_Kind); Set_Node16 (Id, V); end Set_First_Private_Entity; @@ -3546,7 +3485,7 @@ package body Einfo is begin pragma Assert (Is_Type (Id) - or else Ekind (Id) = E_Package); + or else Ekind (Id) = E_Package); Set_Flag159 (Id, V); end Set_From_With_Type; @@ -3713,8 +3652,7 @@ package body Einfo is procedure Set_Has_Initial_Value (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Variable or else Ekind (Id) = E_Out_Parameter); + pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter)); Set_Flag219 (Id, V); end Set_Has_Initial_Value; @@ -3731,8 +3669,7 @@ package body Einfo is procedure Set_Has_Missing_Return (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function); + pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function)); Set_Flag142 (Id, V); end Set_Has_Missing_Return; @@ -3743,10 +3680,7 @@ package body Einfo is procedure Set_Has_Up_Level_Access (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Variable - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Loop_Parameter); + pragma Assert (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter)); Set_Flag215 (Id, V); end Set_Has_Up_Level_Access; @@ -3989,9 +3923,7 @@ package body Einfo is procedure Set_Implemented_By_Entry (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Flag232 (Id, V); end Set_Implemented_By_Entry; @@ -4006,8 +3938,7 @@ package body Einfo is pragma Assert (Is_Internal (Id) and then Is_Hidden (Id) - and then (Ekind (Id) = E_Procedure - or else Ekind (Id) = E_Function)); + and then (Ekind_In (Id, E_Procedure, E_Function))); Set_Node25 (Id, V); end Set_Interface_Alias; @@ -4100,8 +4031,7 @@ package body Einfo is procedure Set_Is_Called (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function); + pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); Set_Flag102 (Id, V); end Set_Is_Called; @@ -4224,10 +4154,7 @@ package body Einfo is procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Record_Subtype - or else - Ekind (Id) = E_Private_Subtype); + pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype)); Set_Flag118 (Id, V); end Set_Is_For_Access_Subtype; @@ -4288,12 +4215,12 @@ package body Einfo is procedure Set_Is_Interface (Id : E; V : B := True) is begin pragma Assert - (Ekind (Id) = E_Record_Type - or else Ekind (Id) = E_Record_Subtype - or else Ekind (Id) = E_Record_Type_With_Private - or else Ekind (Id) = E_Record_Subtype_With_Private - or else Ekind (Id) = E_Class_Wide_Type - or else Ekind (Id) = E_Class_Wide_Subtype); + (Ekind_In (Id, E_Record_Type, + E_Record_Subtype, + E_Record_Type_With_Private, + E_Record_Subtype_With_Private, + E_Class_Wide_Type, + E_Class_Wide_Subtype)); Set_Flag186 (Id, V); end Set_Is_Interface; @@ -4428,15 +4355,13 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Generic_Function - or else Ekind (Id) = E_Generic_Procedure); + or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure)); Set_Flag218 (Id, V); end Set_Is_Primitive; procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is begin - pragma Assert (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Flag195 (Id, V); end Set_Is_Primitive_Wrapper; @@ -4453,8 +4378,7 @@ package body Einfo is procedure Set_Is_Private_Primitive (Id : E; V : B := True) is begin - pragma Assert (Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); Set_Flag245 (Id, V); end Set_Is_Private_Primitive; @@ -4521,11 +4445,11 @@ package body Einfo is procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is begin pragma Assert - (Ekind (Id) = E_Exception - or else Ekind (Id) = E_Variable - or else Ekind (Id) = E_Constant - or else Is_Type (Id) - or else Ekind (Id) = E_Void); + (Is_Type (Id) + or else Ekind_In (Id, E_Exception, + E_Variable, + E_Constant, + E_Void)); Set_Flag28 (Id, V); end Set_Is_Statically_Allocated; @@ -4537,9 +4461,7 @@ package body Einfo is procedure Set_Is_Tag (Id : E; V : B := True) is begin - pragma Assert - (Ekind (Id) = E_Component - or else Ekind (Id) = E_Constant); + pragma Assert (Ekind_In (Id, E_Component, E_Constant)); Set_Flag78 (Id, V); end Set_Is_Tag; @@ -4728,8 +4650,7 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Subprogram_Type - or else Ekind (Id) = E_Entry_Family); + or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family)); Set_Flag22 (Id, V); end Set_Needs_No_Actuals; @@ -4752,9 +4673,7 @@ package body Einfo is procedure Set_No_Return (Id : E; V : B := True) is begin pragma Assert - (V = False - or else Ekind (Id) = E_Procedure - or else Ekind (Id) = E_Generic_Procedure); + (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure)); Set_Flag113 (Id, V); end Set_No_Return; @@ -4786,22 +4705,19 @@ package body Einfo is procedure Set_Normalized_First_Bit (Id : E; V : U) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); Set_Uint8 (Id, V); end Set_Normalized_First_Bit; procedure Set_Normalized_Position (Id : E; V : U) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); Set_Uint14 (Id, V); end Set_Normalized_Position; procedure Set_Normalized_Position_Max (Id : E; V : U) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Component, E_Discriminant)); Set_Uint10 (Id, V); end Set_Normalized_Position_Max; @@ -4821,18 +4737,14 @@ package body Einfo is procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is begin pragma Assert - (Is_Type (Id) - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable)); Set_Flag241 (Id, V); end Set_Optimize_Alignment_Space; procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is begin pragma Assert - (Is_Type (Id) - or else Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable)); Set_Flag242 (Id, V); end Set_Optimize_Alignment_Time; @@ -4844,10 +4756,7 @@ package body Einfo is procedure Set_Original_Record_Component (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Void - or else Ekind (Id) = E_Component - or else Ekind (Id) = E_Discriminant); + pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant)); Set_Node22 (Id, V); end Set_Original_Record_Component; @@ -4863,10 +4772,7 @@ package body Einfo is procedure Set_Package_Instantiation (Id : E; V : N) is begin - pragma Assert - (Ekind (Id) = E_Void - or else Ekind (Id) = E_Generic_Package - or else Ekind (Id) = E_Package); + pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package)); Set_Node26 (Id, V); end Set_Package_Instantiation; @@ -4902,8 +4808,7 @@ package body Einfo is procedure Set_Prival_Link (Id : E; V : E) is begin - pragma Assert (Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable); + pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); Set_Node20 (Id, V); end Set_Prival_Link; @@ -4933,10 +4838,10 @@ package body Einfo is procedure Set_Protection_Object (Id : E; V : E) is begin - pragma Assert (Ekind (Id) = E_Entry - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Entry, + E_Entry_Family, + E_Function, + E_Procedure)); Set_Node23 (Id, V); end Set_Protection_Object; @@ -4985,15 +4890,13 @@ package body Einfo is procedure Set_Related_Instance (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body); + pragma Assert (Ekind_In (Id, E_Package, E_Package_Body)); Set_Node15 (Id, V); end Set_Related_Instance; procedure Set_Related_Type (Id : E; V : E) is begin - pragma Assert - (Ekind (Id) = E_Component or else Ekind (Id) = E_Constant); + pragma Assert (Ekind_In (Id, E_Component, E_Constant)); Set_Node26 (Id, V); end Set_Related_Type; @@ -5081,8 +4984,7 @@ package body Einfo is procedure Set_Shadow_Entities (Id : E; V : S) is begin - pragma Assert - (Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package); + pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)); Set_List14 (Id, V); end Set_Shadow_Entities; @@ -5094,7 +4996,7 @@ package body Einfo is procedure Set_Size_Check_Code (Id : E; V : N) is begin - pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable); + pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); Set_Node19 (Id, V); end Set_Size_Check_Code; @@ -5268,9 +5170,8 @@ package body Einfo is procedure Set_Wrapped_Entity (Id : E; V : E) is begin - pragma Assert ((Ekind (Id) = E_Function - or else Ekind (Id) = E_Procedure) - and then Is_Primitive_Wrapper (Id)); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure) + and then Is_Primitive_Wrapper (Id)); Set_Node27 (Id, V); end Set_Wrapped_Entity; @@ -5765,9 +5666,9 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Subprogram_Body - or else Ekind (Id) = E_Subprogram_Type); + or else Ekind_In (Id, E_Entry_Family, + E_Subprogram_Body, + E_Subprogram_Type)); if Ekind (Id) = E_Enumeration_Literal then return Empty; @@ -5793,9 +5694,9 @@ package body Einfo is begin pragma Assert (Is_Overloadable (Id) - or else Ekind (Id) = E_Entry_Family - or else Ekind (Id) = E_Subprogram_Body - or else Ekind (Id) = E_Subprogram_Type); + or else Ekind_In (Id, E_Entry_Family, + E_Subprogram_Body, + E_Subprogram_Type)); if Ekind (Id) = E_Enumeration_Literal then return Empty; @@ -6098,10 +5999,8 @@ package body Einfo is function Is_Discriminal (Id : E) return B is begin - return - (Ekind (Id) = E_Constant - or else Ekind (Id) = E_In_Parameter) - and then Present (Discriminal_Link (Id)); + return (Ekind_In (Id, E_Constant, E_In_Parameter) + and then Present (Discriminal_Link (Id))); end Is_Discriminal; ---------------------- @@ -6169,10 +6068,8 @@ package body Einfo is function Is_Prival (Id : E) return B is begin - return - (Ekind (Id) = E_Constant - or else Ekind (Id) = E_Variable) - and then Present (Prival_Link (Id)); + return (Ekind_In (Id, E_Constant, E_Variable) + and then Present (Prival_Link (Id))); end Is_Prival; ---------------------------- @@ -6227,8 +6124,8 @@ package body Einfo is begin return Ekind (Id) in String_Kind or else (Is_Array_Type (Id) - and then Number_Dimensions (Id) = 1 - and then Is_Character_Type (Component_Type (Id))); + and then Number_Dimensions (Id) = 1 + and then Is_Character_Type (Component_Type (Id))); end Is_String_Type; ------------------------- @@ -6249,7 +6146,7 @@ package body Einfo is function Is_Wrapper_Package (Id : E) return B is begin return (Ekind (Id) = E_Package - and then Present (Related_Instance (Id))); + and then Present (Related_Instance (Id))); end Is_Wrapper_Package; -------------------- @@ -6279,9 +6176,7 @@ package body Einfo is begin Comp_Id := Next_Entity (Id); while Present (Comp_Id) loop - exit when Ekind (Comp_Id) = E_Component - or else - Ekind (Comp_Id) = E_Discriminant; + exit when Ekind_In (Comp_Id, E_Component, E_Discriminant); Comp_Id := Next_Entity (Comp_Id); end loop; @@ -6318,7 +6213,7 @@ package body Einfo is D := Next_Entity (D); if No (D) or else (Ekind (D) /= E_Discriminant - and then not Is_Itype (D)) + and then not Is_Itype (D)) then return Empty; end if; @@ -8105,9 +8000,7 @@ package body Einfo is begin N := Next_Entity (N); while Present (N) loop - exit when Ekind (N) = E_Component - or else - Ekind (N) = E_Discriminant; + exit when Ekind_In (N, E_Component, E_Discriminant); N := Next_Entity (N); end loop; end Proc_Next_Component_Or_Discriminant; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 69772d6..c850ab0 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2560,10 +2560,10 @@ package body Layout is begin -- For some reasons, access types can cause trouble, So let's - -- just do this for discrete types ??? + -- just do this for scalar types ??? if Present (CT) - and then Is_Discrete_Type (CT) + and then Is_Scalar_Type (CT) and then Known_Static_Esize (CT) then declare diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index db3eac6..80ed051 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12223,7 +12223,6 @@ package body Sem_Ch12 is -- All other cases than aggregates else - -- For pragmas, we propagate the Enabled status for the -- relevant pragmas to the original generic tree. This was -- originally needed for SCO generation. It is no longer @@ -12233,8 +12232,10 @@ package body Sem_Ch12 is if Nkind (N) = N_Pragma and then - (Pragma_Name (N) = Name_Precondition - or else Pragma_Name (N) = Name_Postcondition) + (Pragma_Name (N) = Name_Assert + or else Pragma_Name (N) = Name_Check + or else Pragma_Name (N) = Name_Precondition + or else Pragma_Name (N) = Name_Postcondition) and then Present (Associated_Node (Pragma_Identifier (N))) then Set_Pragma_Enabled (N, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a14f414..fa66b46 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2370,7 +2370,6 @@ package body Sem_Ch13 is -- Get the alignment value to perform error checking Mod_Val := Get_Alignment_Value (Expression (M)); - end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 160bdbb..9245d2d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11071,6 +11071,7 @@ package body Sem_Ch3 is else Set_Ekind (Def_Id, E_Enumeration_Subtype); Set_Is_Character_Type (Def_Id, Is_Character_Type (T)); + Set_First_Literal (Def_Id, First_Literal (T)); end if; Set_Size_Info (Def_Id, (T)); diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 6238c54..39bda75 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -23,8 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Command_Line; use Ada.Command_Line; - with Debug; use Debug; with Lib; use Lib; with Osint; use Osint; @@ -34,8 +32,9 @@ with Validsw; use Validsw; with Sem_Warn; use Sem_Warn; with Stylesw; use Stylesw; -with System.OS_Lib; use System.OS_Lib; +with Ada.Command_Line; use Ada.Command_Line; +with System.OS_Lib; use System.OS_Lib; with System.WCh_Con; use System.WCh_Con; package body Switch.C is @@ -45,8 +44,7 @@ package body Switch.C is function Switch_Subsequently_Cancelled (C : String; - Arg_Rank : Positive) - return Boolean; + Arg_Rank : Positive) return Boolean; -- This function is called from Scan_Front_End_Switches. It determines if -- the switch currently being scanned is followed by a switch of the form -- "-gnat-" & C, where C is the argument. If so, then True is returned, @@ -1098,12 +1096,14 @@ package body Switch.C is function Switch_Subsequently_Cancelled (C : String; - Arg_Rank : Positive) - return Boolean + Arg_Rank : Positive) return Boolean is Arg : Positive; Max : constant Natural := Argument_Count; + begin + -- Loop through arguments following the current one + Arg := Arg_Rank + 1; while Arg < Max loop declare @@ -1117,6 +1117,8 @@ package body Switch.C is Arg := Arg + 1; end loop; + -- No match found, not cancelled + return False; end Switch_Subsequently_Cancelled; diff --git a/gcc/ada/switch-c.ads b/gcc/ada/switch-c.ads index 84d8812..db7ffc3 100644 --- a/gcc/ada/switch-c.ads +++ b/gcc/ada/switch-c.ads @@ -41,6 +41,7 @@ package Switch.C is -- an optional terminating NUL character is allowed. A bad switch causes -- a fatal error exit and control does not return. The call also sets -- Usage_Requested to True if a switch -gnath is encountered. + -- -- Arg_Rank is the position of the switch in the command line arguments. -- It is used for certain switches -gnatx to check if a subsequent switch -- -gnat-x cancels the switch -gnatx. |