From: Arnaud Charlet Date: Tue, 21 Jan 2014 16:31:21 +0000 (+0100) Subject: [multiple changes] X-Git-Tag: upstream/12.2.0~65301 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ef1c051102dd6c40fc8dbaf9ab8d87b06b47b8d0;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2014-01-21 Thomas Quinot * gnat_rm.texi (Scalar_Storage_Order): Update documentation. 2014-01-21 Ed Schonberg * sem_ch12.adb (Set_Instance_Env): In Ada 2012 mode, preserve the value of Assertions_Enabled flag when compiling an instance of an internal unit. This facilitates the use of pre/postconditions in generic internal units, such as the new elementary function libraries. 2014-01-21 Robert Dewar * exp_aggr.adb: Minor reformatting. * sem_attr.adb: Minor reformatting. * sem_res.adb: Minor comment addition. * einfo.adb: Minor comment updates. * freeze.adb: Minor reformatting and code reorganization. 2014-01-21 Ed Schonberg * par-ch4.adb (P_If_Expression): Handle more gracefully an elsif clause that does not have an else part. From-SVN: r206891 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d33381a..a09a80e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2014-01-21 Thomas Quinot + + * gnat_rm.texi (Scalar_Storage_Order): Update documentation. + +2014-01-21 Ed Schonberg + + * sem_ch12.adb (Set_Instance_Env): In Ada 2012 mode, preserve + the value of Assertions_Enabled flag when compiling an instance of + an internal unit. This facilitates the use of pre/postconditions + in generic internal units, such as the new elementary function + libraries. + +2014-01-21 Robert Dewar + + * exp_aggr.adb: Minor reformatting. + * sem_attr.adb: Minor reformatting. + * sem_res.adb: Minor comment addition. + * einfo.adb: Minor comment updates. + * freeze.adb: Minor reformatting and code reorganization. + +2014-01-21 Ed Schonberg + + * par-ch4.adb (P_If_Expression): Handle more gracefully an + elsif clause that does not have an else part. + 2014-01-21 Robert Dewar * checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 65d54bb..88643b8 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -264,8 +264,6 @@ package body Einfo is -- sense for them to be set true for certain subsets of entity kinds. See -- the spec of Einfo for further details. - -- Note: Flag1-Flag3 are not used, for historical reasons - -- Is_Frozen Flag4 -- Has_Discriminants Flag5 -- Is_Dispatching_Operation Flag6 @@ -556,6 +554,10 @@ package body Einfo is -- SPARK_Pragma_Inherited Flag265 -- SPARK_Aux_Pragma_Inherited Flag266 + -- (unused) Flag1 + -- (unused) Flag2 + -- (unused) Flag3 + -- (unused) Flag267 -- (unused) Flag268 -- (unused) Flag269 diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6147001..6c5104b 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3190,7 +3190,7 @@ package body Exp_Aggr is Insert_Action (N, Make_Raise_Constraint_Error (Loc, Condition => Cond, - Reason => CE_Discriminant_Check_Failed)); + Reason => CE_Discriminant_Check_Failed)); end if; return True; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6885625..310511f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -233,7 +233,7 @@ package body Freeze is -- Note that it is legal for a renaming_as_body to rename an intrinsic -- subprogram, as long as the renaming occurs before the new entity - -- is frozen. See RM 8.5.4 (5). + -- is frozen (RM 8.5.4 (5)). if Nkind (Body_Decl) = N_Subprogram_Renaming_Declaration and then Is_Entity_Name (Name (Body_Decl)) @@ -1174,7 +1174,6 @@ package body Freeze is Error_Msg_N ("type of non-byte-aligned component must have same scalar " & "storage order as enclosing composite", Err_Node); - end if; end if; @@ -1257,9 +1256,7 @@ package body Freeze is -- Do not attempt to analyze case where range was in error - if No (Scalar_Range (E)) - or else Error_Posted (Scalar_Range (E)) - then + if No (Scalar_Range (E)) or else Error_Posted (Scalar_Range (E)) then return; end if; @@ -1284,7 +1281,6 @@ package body Freeze is Lo_Bound := Type_Low_Bound (Ancestor); if Compile_Time_Known_Value (Lo_Bound) then - if Expr_Rep_Value (Lo_Bound) >= 0 then Set_Is_Unsigned_Type (E, True); end if; @@ -1452,10 +1448,8 @@ package body Freeze is end if; elsif Ekind (E) in Task_Kind - and then - (Nkind (Parent (E)) = N_Task_Type_Declaration - or else - Nkind (Parent (E)) = N_Single_Task_Declaration) + and then Nkind_In (Parent (E), N_Task_Type_Declaration, + N_Single_Task_Declaration) then Push_Scope (E); Freeze_All (First_Entity (E), After); @@ -1626,10 +1620,8 @@ package body Freeze is end if; elsif Ekind (E) in Task_Kind - and then - (Nkind (Parent (E)) = N_Task_Type_Declaration - or else - Nkind (Parent (E)) = N_Single_Task_Declaration) + and then Nkind_In (Parent (E), N_Task_Type_Declaration, + N_Single_Task_Declaration) then declare Ent : Entity_Id; @@ -2075,11 +2067,12 @@ package body Freeze is -- If packing was requested or if the component size was -- set explicitly, then see if bit packing is required. This -- processing is only done for base types, since all of the - -- representation aspects involved are type-related. This is not - -- just an optimization, if we start processing the subtypes, they - -- interfere with the settings on the base type (this is because - -- Is_Packed has a slightly different meaning before and after - -- freezing). + -- representation aspects involved are type-related. + + -- This is not just an optimization, if we start processing the + -- subtypes, they interfere with the settings on the base type + -- (this is because Is_Packed has a slightly different meaning + -- before and after freezing). declare Csiz : Uint; @@ -2240,10 +2233,11 @@ package body Freeze is -- Check for Atomic_Components or Aliased with unsuitable packing -- or explicit component size clause given. - if (Has_Atomic_Components (Arr) - or else Has_Aliased_Components (Arr)) - and then (Has_Component_Size_Clause (Arr) - or else Is_Packed (Arr)) + if (Has_Atomic_Components (Arr) + or else + Has_Aliased_Components (Arr)) + and then + (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) then Alias_Atomic_Check : declare @@ -2343,19 +2337,13 @@ package body Freeze is & "accessible by separate tasks??", Clause, Arr); if Has_Component_Size_Clause (Arr) then - Error_Msg_Sloc := - Sloc - (Get_Attribute_Definition_Clause - (FS, Attribute_Component_Size)); - Error_Msg_N - ("\because of component size clause#??", - Clause); + Error_Msg_Sloc := Sloc (Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size)); + Error_Msg_N ("\because of component size clause#??", Clause); elsif Has_Pragma_Pack (Arr) then - Error_Msg_Sloc := - Sloc (Get_Rep_Pragma (FS, Name_Pack)); - Error_Msg_N - ("\because of pragma Pack#??", Clause); + Error_Msg_Sloc := Sloc (Get_Rep_Pragma (FS, Name_Pack)); + Error_Msg_N ("\because of pragma Pack#??", Clause); end if; end if; @@ -2433,8 +2421,7 @@ package body Freeze is end loop; if Elmts > Intval (High_Bound - (Scalar_Range - (Standard_Integer))) + 1 + (Scalar_Range (Standard_Integer))) + 1 then Error_Msg_N ("bit packed array type may not have " @@ -2780,7 +2767,7 @@ package body Freeze is if Is_Itype (Etype (Comp)) and then Is_Record_Type (Underlying_Type - (Scope (Etype (Comp)))) + (Scope (Etype (Comp)))) then Undelay_Type (Etype (Comp)); end if; @@ -2820,21 +2807,25 @@ package body Freeze is -- Check for error of component clause given for variable -- sized type. We have to delay this test till this point, -- since the component type has to be frozen for us to know - -- if it is variable length. We omit this test in a generic - -- context, it will be applied at instantiation time. - - -- We also omit this test in CodePeer mode, since we do not - -- have sufficient info on size and representation clauses. + -- if it is variable length. if Present (CC) then Placed_Component := True; + -- We omit this test in a generic context, it will be + -- applied at instantiation time. + if Inside_A_Generic then null; + -- Also omit this test in CodePeer mode, since we do not + -- have sufficient info on size and rep clauses. + elsif CodePeer_Mode then null; + -- Do the check + elsif not Size_Known_At_Compile_Time (Underlying_Type (Etype (Comp))) @@ -3011,11 +3002,11 @@ package body Freeze is and then Present (Expression (Parent (Comp))) and then Nkind (Expression (Parent (Comp))) = N_Aggregate and then Is_Fully_Defined - (Designated_Type (Component_Type (Etype (Comp)))) + (Designated_Type (Component_Type (Etype (Comp)))) then Freeze_And_Append (Designated_Type - (Component_Type (Etype (Comp))), N, Result); + (Component_Type (Etype (Comp))), N, Result); end if; Prev := Comp; @@ -3816,9 +3807,9 @@ package body Freeze is elsif (Is_Tagged_Type (R_Type) or else (Is_Access_Type (R_Type) - and then - Is_Tagged_Type - (Designated_Type (R_Type)))) + and then + Is_Tagged_Type + (Designated_Type (R_Type)))) and then Convention (E) = Convention_C and then not Has_Warnings_Off (E) and then not Has_Warnings_Off (R_Type) @@ -4118,13 +4109,8 @@ package body Freeze is -- Remaining step is to layout objects - if Ekind (E) = E_Variable - or else - Ekind (E) = E_Constant - or else - Ekind (E) = E_Loop_Parameter - or else - Is_Formal (E) + if Ekind_In (E, E_Variable, E_Constant, E_Loop_Parameter) + or else Is_Formal (E) then Layout_Object (E); end if; @@ -4449,8 +4435,7 @@ package body Freeze is elsif Is_Concurrent_Type (E) then if Present (Corresponding_Record_Type (E)) then - Freeze_And_Append - (Corresponding_Record_Type (E), N, Result); + Freeze_And_Append (Corresponding_Record_Type (E), N, Result); end if; Comp := First_Entity (E); @@ -4596,9 +4581,7 @@ package body Freeze is -- amendment type, so diagnosis is at the point of use and the -- type might be frozen later. - elsif E /= Base_Type (E) - or else Is_Derived_Type (E) - then + elsif E /= Base_Type (E) or else Is_Derived_Type (E) then null; else @@ -4813,8 +4796,7 @@ package body Freeze is -- be an array type, or a nonlimited record type). if Has_Private_Declaration (E) then - if (not Is_Record_Type (E) - or else not Is_Limited_View (E)) + if (not Is_Record_Type (E) or else not Is_Limited_View (E)) and then not Is_Private_Type (E) then Error_Msg_Name_1 := Name_Simple_Storage_Pool_Type; @@ -4845,7 +4827,8 @@ package body Freeze is -- Upon return, Pool_Op_Formal will be updated to the next -- formal, if any. - procedure Validate_Simple_Pool_Operation (Op_Name : Name_Id); + procedure Validate_Simple_Pool_Operation + (Op_Name : Name_Id); -- Search for and validate a simple pool operation with the -- name Op_Name. If the name is Allocate, then there must be -- exactly one such primitive operation for the simple pool @@ -6784,18 +6767,16 @@ package body Freeze is -- directly. if Nkind (Dcopy) = N_Identifier - or else Nkind (Dcopy) = N_Expanded_Name - or else Nkind (Dcopy) = N_Integer_Literal + or else Nkind_In (Dcopy, N_Expanded_Name, + N_Integer_Literal, + N_Character_Literal, + N_String_Literal) or else (Nkind (Dcopy) = N_Real_Literal and then not Vax_Float (Etype (Dcopy))) - or else Nkind (Dcopy) = N_Character_Literal - or else Nkind (Dcopy) = N_String_Literal - or else Known_Null (Dcopy) or else (Nkind (Dcopy) = N_Attribute_Reference - and then - Attribute_Name (Dcopy) = Name_Null_Parameter) + and then Attribute_Name (Dcopy) = Name_Null_Parameter) + or else Known_Null (Dcopy) then - -- If there is no default function, we must still do a full -- analyze call on the default value, to ensure that all error -- checks are performed, e.g. those associated with static diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 146936c..9d270c9 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -8897,8 +8897,9 @@ order as the parent type. If a component of @var{S} has itself a record or array type, then it shall also have a @code{Scalar_Storage_Order} attribute definition clause. In addition, -if the component does not start on a byte boundary, then the scalar storage -order specified for S and for the nested component type shall be identical. +if the component is a packed array, or does not start on a byte boundary, then +the scalar storage order specified for S and for the nested component type shall +be identical. If @var{S} appears as the type of a record or array component, the enclosing record or array shall also have a @code{Scalar_Storage_Order} attribute diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 5981f01..ab66f5c 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -3078,6 +3078,7 @@ package body Ch4 is function P_If_Expression return Node_Id is Exprs : constant List_Id := New_List; Loc : constant Source_Ptr := Token_Ptr; + Cond : Node_Id; Expr : Node_Id; State : Saved_Scan_State; @@ -3085,9 +3086,17 @@ package body Ch4 is Inside_If_Expression := Inside_If_Expression + 1; Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr); Scan; -- past IF or ELSIF - Append_To (Exprs, P_Condition); - TF_Then; - Append_To (Exprs, P_Expression); + Cond := P_Condition; + + if Token = Tok_Then then + Scan; -- past THEN + Append_To (Exprs, Cond); + Append_To (Exprs, P_Expression); + + else + Error_Msg ("ELSIF should be ELSE", Loc); + return Cond; + end if; -- We now have scanned out IF expr THEN expr @@ -3110,7 +3119,14 @@ package body Ch4 is if Token = Tok_Elsif then Expr := P_If_Expression; - Set_Is_Elsif (Expr); + + if Nkind (Expr) = N_If_Expression then + Set_Is_Elsif (Expr); + + -- Otherwise, this is an incomplete ELSIF as reported earlier, + -- so treat the expression as a final ELSE for better recovery. + end if; + Append_To (Exprs, Expr); -- Scan out ELSE phrase if present diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 1b585cb..5727e6d 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -9788,8 +9788,9 @@ package body Sem_Attr is Object_Access_Level (P) > Deepest_Type_Access_Level (Btyp) and then Attr_Id = Attribute_Access then - -- In an instance, this is a runtime check, but one we - -- know will fail, so generate an appropriate warning. + -- In an instance, this is a runtime check, but one we know + -- will fail, so generate an appropriate warning. As usual, + -- this kind of warning is an error in SPARK mode. if In_Instance_Body then Error_Msg_Warn := SPARK_Mode /= On; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b59c895..6b9c5fe 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13796,6 +13796,8 @@ package body Sem_Ch12 is (Gen_Unit : Entity_Id; Act_Unit : Entity_Id) is + Assertion_Status : constant Boolean := Assertions_Enabled; + begin -- Regardless of the current mode, predefined units are analyzed in the -- most current Ada mode, and earlier version Ada checks do not apply @@ -13807,6 +13809,16 @@ package body Sem_Ch12 is Renamings_Included => True) then Set_Opt_Config_Switches (True, Current_Sem_Unit = Main_Unit); + + -- In Ada2012 we may want to enable assertions in an instance of a + -- predefined unit, in which case we need to preserve the current + -- setting for the Assertions_Enabled flag. This will become more + -- critical when pre/postconditions are added to predefined units, + -- as is already the case for some numeric libraries. + + if Ada_Version >= Ada_2012 then + Assertions_Enabled := Assertion_Status; + end if; end if; Current_Instantiated_Parent := diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c42a7fa..dbc13d3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9069,6 +9069,8 @@ package body Sem_Res is T := Etype (P); end if; + -- Set flag for expander if discriminant check required + if Has_Discriminants (T) and then Ekind_In (Entity (S), E_Component, E_Discriminant) and then Present (Original_Record_Component (Entity (S)))