diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 39 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/s-rident.ads | 47 | ||||
| -rw-r--r-- | gcc/ada/s-stchop-vxworks.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 43 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 | ||||
| -rw-r--r-- | gcc/ada/targparm.adb | 11 |
9 files changed, 176 insertions, 37 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cd0764a..52b839b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2015-11-12 Tristan Gingold <gingold@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <falis@adacore.com> + + * s-stchop-vxworks.adb: Clean up in stack checking code. + +2015-11-12 Gary Dismukes <dismukes@adacore.com> + + * 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 <quinot@adacore.com> * 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 6aaeb87..bdde498 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 446ddb9..58c69d8 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 @@ -505,6 +506,52 @@ package System.Rident is 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, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, others => 0))); end System.Rident; diff --git a/gcc/ada/s-stchop-vxworks.adb b/gcc/ada/s-stchop-vxworks.adb index ffdba81..06ec151 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 bf134ba..373c9e8 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 a2b4442..4d696c4 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 3af69c9..3b3bc2b 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 ba4053d..1087806 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 42696cf..33983c7 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) = |