+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
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);
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);
(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
-- 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,
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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.
-- 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
-- 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
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;
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;
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.
-- 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 --
-- 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)
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
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.
-- 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
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
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
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;
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 + $;
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) =
git://gcc.gnu.org / gcc.git / commitdiff