From: Arnaud Charlet Date: Thu, 12 Nov 2015 11:46:35 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b3083540f530b6e28e57756e23c98670f69df4af;p=gcc.git [multiple changes] 2015-11-12 Tristan Gingold * snames.ads-tmpl: Name_Gnat_Extended_Ravenscar: New identifier. * s-rident.ads (Profile_Name): Add GNAT_Extended_Ravenscar. (Profile_Info): Add new entry for GNAT_Extended_Ravenscar. * sem_prag.adb (Set_Ravenscar_Profile): Add Profile parameter to handle various ravenscar profiles. Adjust error messages. (Analyze_Pragma): Handle GNAT_Extended_Ravenscar profile. * targparm.adb (Get_Target_Parameters): Handle GNAT_Extended_Ravenscar profile. 2015-11-12 Ed Schonberg * sem_warn.adb (Warn_On_Unreferenced_Entity): If the entity is an Out_Parameter the front-end does not emit any warning on it, so do not suppress warnings on the entity because the backend might be able to determine an uninitialized path and warn accordingly. 2015-11-12 Ed Schonberg * sem_ch4.adb (Analyze_Selected_Component): Diagnose an attempt to reference an internal entity from a synchronized type from within the body of that type, when the prefix of the selected component is not the current instance. 2015-11-12 Ed Falis * s-stchop-vxworks.adb: Clean up in stack checking code. 2015-11-12 Gary Dismukes * exp_ch6.adb (Is_Build_In_Place_Function_Call): Test Expression (N) in N_Type_Conversion cases as well, since conversions can occur in actual parameter contexts. (Make_Build_In_Place_Call_In_Anonymous_Context): Retrieve function call from Expression (Func_Call) when Nkind (Func_Call) is N_Type_Conversion, since conversions are allowed in "anonymous" contexts (specifically, as actual parameters). From-SVN: r230242 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cd0764a4a86..52b839b7fc5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2015-11-12 Tristan Gingold + + * snames.ads-tmpl: Name_Gnat_Extended_Ravenscar: New identifier. + * s-rident.ads (Profile_Name): Add GNAT_Extended_Ravenscar. + (Profile_Info): Add new entry for GNAT_Extended_Ravenscar. + * sem_prag.adb (Set_Ravenscar_Profile): Add Profile parameter + to handle various ravenscar profiles. Adjust error messages. + (Analyze_Pragma): Handle GNAT_Extended_Ravenscar profile. + * targparm.adb (Get_Target_Parameters): Handle + GNAT_Extended_Ravenscar profile. + +2015-11-12 Ed Schonberg + + * sem_warn.adb (Warn_On_Unreferenced_Entity): If the entity is an + Out_Parameter the front-end does not emit any warning on it, so + do not suppress warnings on the entity because the backend might + be able to determine an uninitialized path and warn accordingly. + +2015-11-12 Ed Schonberg + + * sem_ch4.adb (Analyze_Selected_Component): Diagnose an attempt + to reference an internal entity from a synchronized type from + within the body of that type, when the prefix of the selected + component is not the current instance. + +2015-11-12 Ed Falis + + * s-stchop-vxworks.adb: Clean up in stack checking code. + +2015-11-12 Gary Dismukes + + * exp_ch6.adb (Is_Build_In_Place_Function_Call): + Test Expression (N) in N_Type_Conversion cases as well, + since conversions can occur in actual parameter contexts. + (Make_Build_In_Place_Call_In_Anonymous_Context): Retrieve + function call from Expression (Func_Call) when Nkind (Func_Call) + is N_Type_Conversion, since conversions are allowed in "anonymous" + contexts (specifically, as actual parameters). + 2015-11-12 Thomas Quinot * sem_ch4.adb (analyze_If_Expression): Reject IF-expression where diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6aaeb87372d..bdde498306a 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6893,10 +6893,12 @@ package body Exp_Ch6 is return False; end if; - -- Step past qualification or unchecked conversion (the latter can occur - -- in cases of calls to 'Input). + -- Step past qualification, type conversion (which can occur in actual + -- parameter contexts), and unchecked conversion (which can occur in + -- cases of calls to 'Input). if Nkind_In (Exp_Node, N_Qualified_Expression, + N_Type_Conversion, N_Unchecked_Type_Conversion) then Exp_Node := Expression (N); @@ -7425,10 +7427,12 @@ package body Exp_Ch6 is Return_Obj_Decl : Entity_Id; begin - -- Step past qualification or unchecked conversion (the latter can occur - -- in cases of calls to 'Input). + -- Step past qualification, type conversion (which can occur in actual + -- parameter contexts), and unchecked conversion (which can occur in + -- cases of calls to 'Input). if Nkind_In (Func_Call, N_Qualified_Expression, + N_Type_Conversion, N_Unchecked_Type_Conversion) then Func_Call := Expression (Func_Call); diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 446ddb9f412..58c69d865fc 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -378,6 +378,7 @@ package System.Rident is (No_Profile, No_Implementation_Extensions, Ravenscar, + GNAT_Extended_Ravenscar, Restricted); -- Names of recognized profiles. No_Profile is used to indicate that a -- restriction came from pragma Restrictions[_Warning], as opposed to @@ -500,6 +501,52 @@ package System.Rident is -- Value settings for Ravenscar (same as Restricted) + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Protected_Entries => 1, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, + others => 0)), + + GNAT_Extended_Ravenscar => + + -- Restrictions for GNAT_Extended_Ravenscar = + -- Restricted profile .. + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => True, + No_Entry_Queue => True, + No_Local_Protected_Objects => True, + No_Protected_Type_Allocators => True, + No_Requeue_Statements => True, + No_Task_Allocators => True, + No_Task_Attributes_Package => True, + No_Task_Hierarchy => True, + No_Terminate_Alternatives => True, + Max_Asynchronous_Select_Nesting => True, + Max_Protected_Entries => True, + Max_Select_Alternatives => True, + Max_Task_Entries => True, + + -- plus these additional restrictions: + + No_Calendar => True, + No_Implicit_Task_Allocations => True, + No_Implicit_Protected_Object_Allocations + => True, + No_Local_Timing_Events => True, + No_Relative_Delay => True, + No_Select_Statements => True, + No_Specific_Termination_Handlers => True, + No_Task_Termination => True, + Simple_Barriers => True, + others => False), + + -- Value settings for Ravenscar (same as Restricted) + Value => (Max_Asynchronous_Select_Nesting => 0, Max_Protected_Entries => 1, diff --git a/gcc/ada/s-stchop-vxworks.adb b/gcc/ada/s-stchop-vxworks.adb index ffdba814a43..06ec151ef39 100644 --- a/gcc/ada/s-stchop-vxworks.adb +++ b/gcc/ada/s-stchop-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2015, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- This is the verson for VxWorks 5 and VxWorks MILS +-- This is the verson for VxWorks 5, VxWorks 6 Cert and VxWorks MILS -- This file should be kept synchronized with the general implementation -- provided by s-stchop.adb. @@ -47,9 +47,9 @@ package body System.Stack_Checking.Operations is -- In order to have stack checking working appropriately on VxWorks we need -- to extract the stack size information from the VxWorks kernel itself. - -- For VxWorks 5 the library for showing task-related information needs to - -- be linked into the VxWorks system, when using stack checking. The - -- taskShow library can be linked into the VxWorks system by either: + -- For VxWorks 5 & 6 the library for showing task-related information + -- needs to be linked into the VxWorks system, when using stack checking. + -- The taskShow library can be linked into the VxWorks system by either: -- * defining INCLUDE_SHOW_ROUTINES in config.h when using -- configuration header files, or @@ -60,10 +60,10 @@ package body System.Stack_Checking.Operations is -- VxWorks MILS includes the necessary routine in taskLib, so nothing -- special needs to be done there. - Stack_Limit : Address := - Boolean'Pos (Stack_Grows_Down) * Address'First - + Boolean'Pos (not Stack_Grows_Down) * Address'Last; - pragma Export (C, Stack_Limit, "__gnat_stack_limit"); + Stack_Limit : Address; + + pragma Import (C, Stack_Limit, "__gnat_stack_limit"); + -- Stack_Limit contains the limit of the stack. This variable is later made -- a task variable (by calling taskVarAdd) and then correctly set to the -- stack limit of the task. Before being so initialized its value must be @@ -106,11 +106,6 @@ package body System.Stack_Checking.Operations is procedure Set_Stack_Limit_For_Current_Task is use Interfaces.C; - function Task_Var_Add (Tid : Interfaces.C.int; Var : Address) - return Interfaces.C.int; - pragma Import (C, Task_Var_Add, "taskVarAdd"); - -- Import from VxWorks - type OS_Stack_Info is record Size : Interfaces.C.int; Base : System.Address; @@ -134,20 +129,16 @@ package body System.Stack_Checking.Operations is Get_Stack_Info (Stack_Info'Access); - -- In s-stchop.adb, we check for overflow in the following operations, - -- but we have no such check in this vxworks version. Why not ??? - if Stack_Grows_Down then - Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size); + Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size) + + Storage_Offset'(16#12_000#); else - Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size); + Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size) + - Storage_Offset'(16#12_000#); end if; - -- Note: taskVarAdd implicitly calls taskVarInit if required + Stack_Limit := Limit; - if Task_Var_Add (0, Stack_Limit'Address) = 0 then - Stack_Limit := Limit; - end if; end Set_Stack_Limit_For_Current_Task; end System.Stack_Checking.Operations; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index bf134ba8640..373c9e86fae 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4655,6 +4655,23 @@ package body Sem_Ch4 is Comp = First_Private_Entity (Base_Type (Prefix_Type)); end loop; + -- If the scope is a current instance, the prefix cannot be an + -- expression of the same type (that would represent an attempt + -- to reach an internal operation of another synchronized object). + -- This is legal if prefix is an access to such type and there is + -- a dereference. + + if In_Scope + and then not Is_Entity_Name (Name) + and then Nkind (Name) /= N_Explicit_Dereference + then + Error_Msg_NE ("invalid reference to internal operation " + & "of some object of type&", N, Type_To_Use); + Set_Entity (Sel, Any_Id); + Set_Etype (Sel, Any_Type); + return; + end if; + -- If there is no visible entity with the given name or none of the -- visible entities are plausible interpretations, check whether -- there is some other primitive operation with that name. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a2b4442db8d..4d696c49b19 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3737,10 +3737,11 @@ package body Sem_Prag is -- Activate the set of configuration pragmas and permissions that make -- up the Rational profile. - procedure Set_Ravenscar_Profile (N : Node_Id); + procedure Set_Ravenscar_Profile (Profile : Profile_Name; N : Node_Id); -- Activate the set of configuration pragmas and restrictions that make - -- up the Ravenscar Profile. N is the corresponding pragma node, which - -- is used for error messages on any constructs violating the profile. + -- up the Profile. Profile must be either GNAT_Extended_Ravencar or + -- Ravenscar. N is the corresponding pragma node, which is used for + -- error messages on any constructs violating the profile. ---------------------------------- -- Acquire_Warning_Match_String -- @@ -9654,12 +9655,31 @@ package body Sem_Prag is -- No_Dependence => Ada.Task_Attributes -- No_Dependence => System.Multiprocessors.Dispatching_Domains - procedure Set_Ravenscar_Profile (N : Node_Id) is + procedure Set_Ravenscar_Profile (Profile : Profile_Name; N : Node_Id) is Prefix_Entity : Entity_Id; Selector_Entity : Entity_Id; Prefix_Node : Node_Id; Node : Node_Id; + procedure Set_Error_Msg_To_Profile_Name; + -- Set Error_Msg_String and Error_Msg_Strlen to the name of the + -- profile. + + ----------------------------------- + -- Set_Error_Msg_To_Profile_Name -- + ----------------------------------- + + procedure Set_Error_Msg_To_Profile_Name is + Pragma_Args : constant List_Id := + Pragma_Argument_Associations (N); + Profile_Name : constant Node_Id := + Get_Pragma_Arg (First (Pragma_Args)); + begin + Get_Name_String (Chars (Profile_Name)); + Adjust_Name_Case (Sloc (Profile_Name)); + Error_Msg_Strlen := Name_Len; + Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); + end Set_Error_Msg_To_Profile_Name; begin -- pragma Task_Dispatching_Policy (FIFO_Within_Priorities) @@ -9667,7 +9687,8 @@ package body Sem_Prag is and then Task_Dispatching_Policy /= 'F' then Error_Msg_Sloc := Task_Dispatching_Policy_Sloc; - Error_Pragma ("Profile (Ravenscar) incompatible with policy#"); + Set_Error_Msg_To_Profile_Name; + Error_Pragma ("Profile (~) incompatible with policy#"); -- Set the FIFO_Within_Priorities policy, but always preserve -- System_Location since we like the error message with the run time @@ -9687,7 +9708,8 @@ package body Sem_Prag is and then Locking_Policy /= 'C' then Error_Msg_Sloc := Locking_Policy_Sloc; - Error_Pragma ("Profile (Ravenscar) incompatible with policy#"); + Set_Error_Msg_To_Profile_Name; + Error_Pragma ("Profile (~) incompatible with policy#"); -- Set the Ceiling_Locking policy, but preserve System_Location since -- we like the error message with the run time name. @@ -9707,7 +9729,7 @@ package body Sem_Prag is -- Set the corresponding restrictions Set_Profile_Restrictions - (Ravenscar, N, Warn => Treat_Restrictions_As_Warnings); + (Profile, N, Warn => Treat_Restrictions_As_Warnings); -- Set the No_Dependence restrictions @@ -18798,7 +18820,10 @@ package body Sem_Prag is begin if Chars (Argx) = Name_Ravenscar then - Set_Ravenscar_Profile (N); + Set_Ravenscar_Profile (Ravenscar, N); + + elsif Chars (Argx) = Name_Gnat_Extended_Ravenscar then + Set_Ravenscar_Profile (GNAT_Extended_Ravenscar, N); elsif Chars (Argx) = Name_Restricted then Set_Profile_Restrictions @@ -19721,7 +19746,7 @@ package body Sem_Prag is GNAT_Pragma; Check_Arg_Count (0); Check_Valid_Configuration_Pragma; - Set_Ravenscar_Profile (N); + Set_Ravenscar_Profile (Ravenscar, N); if Warn_On_Obsolescent_Feature then Error_Msg_N diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 3af69c9fbd0..3b3bc2b0f8b 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -4217,8 +4217,12 @@ package body Sem_Warn is end case; -- Kill warnings on the entity on which the message has been posted + -- (nothing is posted on out parameters because back end might be + -- able to uncover an uninitialized path, and warn accordingly). - Set_Warnings_Off (E); + if Ekind (E) /= E_Out_Parameter then + Set_Warnings_Off (E); + end if; end if; end Warn_On_Unreferenced_Entity; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index ba4053dab51..10878063b79 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -738,6 +738,7 @@ package Snames is Name_Gcc : constant Name_Id := N + $; Name_General : constant Name_Id := N + $; Name_Gnat : constant Name_Id := N + $; + Name_Gnat_Extended_Ravenscar : constant Name_Id := N + $; Name_Gnatprove : constant Name_Id := N + $; Name_GPL : constant Name_Id := N + $; Name_High_Order_First : constant Name_Id := N + $; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 42696cf0ba2..33983c71d01 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -293,6 +293,17 @@ package body Targparm is P := P + 27; goto Line_Loop_Continue; + -- Test for pragma Profile (GNAT_Extended_Ravenscar); + + elsif System_Text (P .. P + 40) = + "pragma Profile (GNAT_Extended_Ravenscar);" + then + Set_Profile_Restrictions (GNAT_Extended_Ravenscar); + Opt.Task_Dispatching_Policy := 'F'; + Opt.Locking_Policy := 'C'; + P := P + 27; + goto Line_Loop_Continue; + -- Test for pragma Profile (Restricted); elsif System_Text (P .. P + 27) =