[multiple changes]
2014-01-31 Robert Dewar <dewar@adacore.com> * exp_ch9.adb, s-tassta.adb, s-tposen.adb, s-tposen.ads: Minor reformatting. 2014-01-31 Tristan Gingold <gingold@adacore.com> * exp_disp.adb: Add a historic note. 2014-01-31 Robert Dewar <dewar@adacore.com> * sem_warn.adb (Warn_On_Useless_Assignments): Add call to Process_Deferred_References. 2014-01-31 Yannick Moy <moy@adacore.com> * erroutc.adb (Validate_Specific_Warnings): Do not issue a message for ineffective pragma Warnings(Off) in GNATprove_Mode. From-SVN: r207351
This commit is contained in:
parent
5b0e6852b1
commit
bdfb8ec4aa
|
@ -1,3 +1,22 @@
|
||||||
|
2014-01-31 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch9.adb, s-tassta.adb, s-tposen.adb, s-tposen.ads: Minor
|
||||||
|
reformatting.
|
||||||
|
|
||||||
|
2014-01-31 Tristan Gingold <gingold@adacore.com>
|
||||||
|
|
||||||
|
* exp_disp.adb: Add a historic note.
|
||||||
|
|
||||||
|
2014-01-31 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* sem_warn.adb (Warn_On_Useless_Assignments): Add call to
|
||||||
|
Process_Deferred_References.
|
||||||
|
|
||||||
|
2014-01-31 Yannick Moy <moy@adacore.com>
|
||||||
|
|
||||||
|
* erroutc.adb (Validate_Specific_Warnings): Do not issue a message for
|
||||||
|
ineffective pragma Warnings(Off) in GNATprove_Mode.
|
||||||
|
|
||||||
2014-01-31 Bob Duff <duff@adacore.com>
|
2014-01-31 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
* s-taskin.ads: Minor comment fix.
|
* s-taskin.ads: Minor comment fix.
|
||||||
|
|
|
@ -1318,6 +1318,13 @@ package body Erroutc is
|
||||||
|
|
||||||
elsif not SWE.Used
|
elsif not SWE.Used
|
||||||
|
|
||||||
|
-- Do not issue this warning in GNATprove_Mode, as not
|
||||||
|
-- all warnings may be generated in this mode, and pragma
|
||||||
|
-- Warnings(Off) may correspond to warnings generated by the
|
||||||
|
-- formal verification backend instead of frontend warnings.
|
||||||
|
|
||||||
|
and then not GNATprove_Mode
|
||||||
|
|
||||||
-- Do not issue this warning for -Wxxx messages since the
|
-- Do not issue this warning for -Wxxx messages since the
|
||||||
-- back-end doesn't report the information.
|
-- back-end doesn't report the information.
|
||||||
|
|
||||||
|
|
|
@ -4723,7 +4723,6 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Actual := First_Actual (N);
|
Actual := First_Actual (N);
|
||||||
Formal := First_Formal (Ent);
|
Formal := First_Formal (Ent);
|
||||||
|
|
||||||
while Present (Actual) loop
|
while Present (Actual) loop
|
||||||
|
|
||||||
-- If it is a by_copy_type, copy it to a new variable. The
|
-- If it is a by_copy_type, copy it to a new variable. The
|
||||||
|
@ -4786,7 +4785,7 @@ package body Exp_Ch9 is
|
||||||
Append_To (Plist,
|
Append_To (Plist,
|
||||||
Make_Attribute_Reference (Loc,
|
Make_Attribute_Reference (Loc,
|
||||||
Attribute_Name => Name_Unchecked_Access,
|
Attribute_Name => Name_Unchecked_Access,
|
||||||
Prefix =>
|
Prefix =>
|
||||||
New_Reference_To (Defining_Identifier (N_Node), Loc)));
|
New_Reference_To (Defining_Identifier (N_Node), Loc)));
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -4834,9 +4833,9 @@ package body Exp_Ch9 is
|
||||||
Pdecl :=
|
Pdecl :=
|
||||||
Make_Object_Declaration (Loc,
|
Make_Object_Declaration (Loc,
|
||||||
Defining_Identifier => P,
|
Defining_Identifier => P,
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
New_Reference_To (Designated_Type (Ent_Acc), Loc),
|
New_Reference_To (Designated_Type (Ent_Acc), Loc),
|
||||||
Expression =>
|
Expression =>
|
||||||
Make_Aggregate (Loc, Expressions => Plist));
|
Make_Aggregate (Loc, Expressions => Plist));
|
||||||
|
|
||||||
Parm3 :=
|
Parm3 :=
|
||||||
|
@ -5064,8 +5063,8 @@ package body Exp_Ch9 is
|
||||||
else
|
else
|
||||||
if Present (Handled_Statement_Sequence (N)) then
|
if Present (Handled_Statement_Sequence (N)) then
|
||||||
|
|
||||||
-- The call goes at the start of the statement sequence
|
-- The call goes at the start of the statement sequence after
|
||||||
-- after the start of exception range label if one is present.
|
-- the start of exception range label if one is present.
|
||||||
|
|
||||||
declare
|
declare
|
||||||
Stm : Node_Id;
|
Stm : Node_Id;
|
||||||
|
@ -5106,7 +5105,7 @@ package body Exp_Ch9 is
|
||||||
else
|
else
|
||||||
Set_Handled_Statement_Sequence (N,
|
Set_Handled_Statement_Sequence (N,
|
||||||
Make_Handled_Sequence_Of_Statements (Loc,
|
Make_Handled_Sequence_Of_Statements (Loc,
|
||||||
Statements => New_List (Call)));
|
Statements => New_List (Call)));
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -5151,13 +5150,13 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Statements => New_List (
|
Statements => New_List (
|
||||||
|
|
||||||
-- Init (Args);
|
-- Init (Args);
|
||||||
|
|
||||||
Make_Procedure_Call_Statement (Loc,
|
Make_Procedure_Call_Statement (Loc,
|
||||||
Name => New_Reference_To (Init, Loc),
|
Name => New_Reference_To (Init, Loc),
|
||||||
Parameter_Associations => Args),
|
Parameter_Associations => Args),
|
||||||
|
|
||||||
-- Activate_Tasks (_Chain);
|
-- Activate_Tasks (_Chain);
|
||||||
|
|
||||||
Make_Procedure_Call_Statement (Loc,
|
Make_Procedure_Call_Statement (Loc,
|
||||||
Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
|
Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
|
||||||
|
@ -5212,7 +5211,7 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Make_Object_Declaration (Loc,
|
Make_Object_Declaration (Loc,
|
||||||
Defining_Identifier => Chain,
|
Defining_Identifier => Chain,
|
||||||
Aliased_Present => True,
|
Aliased_Present => True,
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
New_Reference_To (RTE (RE_Activation_Chain), Loc))),
|
New_Reference_To (RTE (RE_Activation_Chain), Loc))),
|
||||||
|
|
||||||
|
@ -5245,15 +5244,13 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
if Comes_From_Source (T) then
|
if Comes_From_Source (T) then
|
||||||
Spec_Id :=
|
Spec_Id :=
|
||||||
Make_Defining_Identifier (Loc,
|
Make_Defining_Identifier (Loc, New_External_Name (Chars (T), "TB"));
|
||||||
Chars => New_External_Name (Chars (T), "TB"));
|
|
||||||
|
|
||||||
-- Case of anonymous task type, suffix B
|
-- Case of anonymous task type, suffix B
|
||||||
|
|
||||||
else
|
else
|
||||||
Spec_Id :=
|
Spec_Id :=
|
||||||
Make_Defining_Identifier (Loc,
|
Make_Defining_Identifier (Loc, New_External_Name (Chars (T), 'B'));
|
||||||
Chars => New_External_Name (Chars (T), 'B'));
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Set_Is_Internal (Spec_Id);
|
Set_Is_Internal (Spec_Id);
|
||||||
|
@ -5382,7 +5379,7 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Append_To (Cdecls,
|
Append_To (Cdecls,
|
||||||
Make_Component_Declaration (Loc,
|
Make_Component_Declaration (Loc,
|
||||||
Defining_Identifier =>
|
Defining_Identifier =>
|
||||||
Make_Defining_Identifier (Loc, Chars (Efam)),
|
Make_Defining_Identifier (Loc, Chars (Efam)),
|
||||||
|
|
||||||
Component_Definition =>
|
Component_Definition =>
|
||||||
|
@ -5393,12 +5390,12 @@ package body Exp_Ch9 is
|
||||||
Subtype_Mark =>
|
Subtype_Mark =>
|
||||||
New_Occurrence_Of (Efam_Type, Loc),
|
New_Occurrence_Of (Efam_Type, Loc),
|
||||||
|
|
||||||
Constraint =>
|
Constraint =>
|
||||||
Make_Index_Or_Discriminant_Constraint (Loc,
|
Make_Index_Or_Discriminant_Constraint (Loc,
|
||||||
Constraints => New_List (
|
Constraints => New_List (
|
||||||
New_Occurrence_Of
|
New_Occurrence_Of
|
||||||
(Etype (Discrete_Subtype_Definition
|
(Etype (Discrete_Subtype_Definition
|
||||||
(Parent (Efam))), Loc)))))));
|
(Parent (Efam))), Loc)))))));
|
||||||
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -5528,9 +5525,7 @@ package body Exp_Ch9 is
|
||||||
-- assume that it can be called from an inner task, and therefore
|
-- assume that it can be called from an inner task, and therefore
|
||||||
-- cannot treat it as a local reference.
|
-- cannot treat it as a local reference.
|
||||||
|
|
||||||
elsif Is_Overloadable (Scop)
|
elsif Is_Overloadable (Scop) and then In_Open_Scopes (T) then
|
||||||
and then In_Open_Scopes (T)
|
|
||||||
then
|
|
||||||
return False;
|
return False;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -5558,7 +5553,7 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
return
|
return
|
||||||
Make_Selected_Component (Loc,
|
Make_Selected_Component (Loc,
|
||||||
Prefix =>
|
Prefix =>
|
||||||
Unchecked_Convert_To (Corresponding_Record_Type (Dtyp),
|
Unchecked_Convert_To (Corresponding_Record_Type (Dtyp),
|
||||||
Make_Explicit_Dereference (Loc, N)),
|
Make_Explicit_Dereference (Loc, N)),
|
||||||
Selector_Name => Make_Identifier (Loc, Sel));
|
Selector_Name => Make_Identifier (Loc, Sel));
|
||||||
|
@ -5820,8 +5815,8 @@ package body Exp_Ch9 is
|
||||||
if Restriction_Active (No_Task_Hierarchy) = False then
|
if Restriction_Active (No_Task_Hierarchy) = False then
|
||||||
Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
|
Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
|
||||||
|
|
||||||
-- The block may have no declarations, and nevertheless be a task
|
-- The block may have no declarations (and nevertheless be a task
|
||||||
-- master, if it contains a call that may return an object that
|
-- master) if it contains a call that may return an object that
|
||||||
-- contains tasks.
|
-- contains tasks.
|
||||||
|
|
||||||
if No (Declarations (N)) then
|
if No (Declarations (N)) then
|
||||||
|
@ -5993,10 +5988,10 @@ package body Exp_Ch9 is
|
||||||
Next (Alt);
|
Next (Alt);
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
-- If we are the first accept statement, then we have to create
|
-- If this is the first accept statement, then we have to
|
||||||
-- the Ann variable, as for the stand alone case, except that
|
-- create the Ann variable, as for the stand alone case, except
|
||||||
-- it is inserted before the selective accept. Similarly, a
|
-- that it is inserted before the selective accept. Similarly,
|
||||||
-- label for requeue expansion must be declared.
|
-- a label for requeue expansion must be declared.
|
||||||
|
|
||||||
if N = Accept_Statement (Alt) then
|
if N = Accept_Statement (Alt) then
|
||||||
Ann := Make_Temporary (Loc, 'A');
|
Ann := Make_Temporary (Loc, 'A');
|
||||||
|
@ -6008,7 +6003,7 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Insert_Before_And_Analyze (Sel_Acc, Adecl);
|
Insert_Before_And_Analyze (Sel_Acc, Adecl);
|
||||||
|
|
||||||
-- If we are not the first accept statement, then find the Ann
|
-- If this is not the first accept statement, then find the Ann
|
||||||
-- variable allocated by the first accept and use it.
|
-- variable allocated by the first accept and use it.
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -6227,7 +6222,7 @@ package body Exp_Ch9 is
|
||||||
-- The Ravenscar profile restricts barriers to simple variables declared
|
-- The Ravenscar profile restricts barriers to simple variables declared
|
||||||
-- within the protected object. We also allow Boolean constants, since
|
-- within the protected object. We also allow Boolean constants, since
|
||||||
-- these appear in several published examples and are also allowed by
|
-- these appear in several published examples and are also allowed by
|
||||||
-- the Aonix compiler.
|
-- other compilers.
|
||||||
|
|
||||||
-- Note that after analysis variables in this context will be replaced
|
-- Note that after analysis variables in this context will be replaced
|
||||||
-- by the corresponding prival, that is to say a renaming of a selected
|
-- by the corresponding prival, that is to say a renaming of a selected
|
||||||
|
@ -6300,8 +6295,8 @@ package body Exp_Ch9 is
|
||||||
while Present (Tasknm) loop
|
while Present (Tasknm) loop
|
||||||
Count := Count + 1;
|
Count := Count + 1;
|
||||||
|
|
||||||
-- A task interface class-wide type object is being aborted.
|
-- A task interface class-wide type object is being aborted. Retrieve
|
||||||
-- Retrieve its _task_id by calling a dispatching routine.
|
-- its _task_id by calling a dispatching routine.
|
||||||
|
|
||||||
if Ada_Version >= Ada_2005
|
if Ada_Version >= Ada_2005
|
||||||
and then Ekind (Etype (Tasknm)) = E_Class_Wide_Type
|
and then Ekind (Etype (Tasknm)) = E_Class_Wide_Type
|
||||||
|
@ -6349,14 +6344,14 @@ package body Exp_Ch9 is
|
||||||
-- Expand_N_Accept_Statement --
|
-- Expand_N_Accept_Statement --
|
||||||
-------------------------------
|
-------------------------------
|
||||||
|
|
||||||
-- This procedure handles expansion of accept statements that stand
|
-- This procedure handles expansion of accept statements that stand alone,
|
||||||
-- alone, i.e. they are not part of an accept alternative. The expansion
|
-- i.e. they are not part of an accept alternative. The expansion of
|
||||||
-- of accept statement in accept alternatives is handled by the routines
|
-- accept statement in accept alternatives is handled by the routines
|
||||||
-- Expand_N_Accept_Alternative and Expand_N_Selective_Accept. The
|
-- Expand_N_Accept_Alternative and Expand_N_Selective_Accept. The
|
||||||
-- following description applies only to stand alone accept statements.
|
-- following description applies only to stand alone accept statements.
|
||||||
|
|
||||||
-- If there is no handled statement sequence, or only null statements,
|
-- If there is no handled statement sequence, or only null statements, then
|
||||||
-- then this is called a trivial accept, and the expansion is:
|
-- this is called a trivial accept, and the expansion is:
|
||||||
|
|
||||||
-- Accept_Trivial (entry-index)
|
-- Accept_Trivial (entry-index)
|
||||||
|
|
||||||
|
@ -6399,7 +6394,7 @@ package body Exp_Ch9 is
|
||||||
-- an accept statement has no declarative part). In particular, if the
|
-- an accept statement has no declarative part). In particular, if the
|
||||||
-- expander is active, the first such declaration is the declaration of
|
-- expander is active, the first such declaration is the declaration of
|
||||||
-- the Accept_Params_Ptr entity (see Sem_Ch9.Analyze_Accept_Statement).
|
-- the Accept_Params_Ptr entity (see Sem_Ch9.Analyze_Accept_Statement).
|
||||||
--
|
|
||||||
-- The two blocks are merged into a single block if the inner block has
|
-- The two blocks are merged into a single block if the inner block has
|
||||||
-- no exception handlers, but otherwise two blocks are required, since
|
-- no exception handlers, but otherwise two blocks are required, since
|
||||||
-- exceptions might be raised in the exception handlers of the inner
|
-- exceptions might be raised in the exception handlers of the inner
|
||||||
|
@ -6443,7 +6438,6 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
D := First (Declarations (N));
|
D := First (Declarations (N));
|
||||||
|
|
||||||
while Present (D) loop
|
while Present (D) loop
|
||||||
Next_D := Next (D);
|
Next_D := Next (D);
|
||||||
if Nkind (D) = N_Object_Renaming_Declaration then
|
if Nkind (D) = N_Object_Renaming_Declaration then
|
||||||
|
@ -6806,8 +6800,8 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
-- The job is to convert this to the asynchronous form
|
-- The job is to convert this to the asynchronous form
|
||||||
|
|
||||||
-- If the trigger is a delay statement, it will have been expanded into a
|
-- If the trigger is a delay statement, it will have been expanded into
|
||||||
-- call to one of the GNARL delay procedures. This routine will convert
|
-- a call to one of the GNARL delay procedures. This routine will convert
|
||||||
-- this into a protected entry call on a delay object and then continue
|
-- this into a protected entry call on a delay object and then continue
|
||||||
-- processing as for a protected entry call trigger. This requires
|
-- processing as for a protected entry call trigger. This requires
|
||||||
-- declaring a Delay_Block object and adding a pointer to this object to
|
-- declaring a Delay_Block object and adding a pointer to this object to
|
||||||
|
|
|
@ -3522,6 +3522,13 @@ package body Exp_Disp is
|
||||||
-- the wrapped parameters, D is the delay amount, M is the delay
|
-- the wrapped parameters, D is the delay amount, M is the delay
|
||||||
-- mode and F is the status flag.
|
-- mode and F is the status flag.
|
||||||
|
|
||||||
|
-- Historically, there was also an implementation for single
|
||||||
|
-- entry protected types (in s-tposen). However, it was removed
|
||||||
|
-- by also testing for no No_Select_Statements restriction in
|
||||||
|
-- Exp_Utils.Corresponding_Runtime_Package. This simplified the
|
||||||
|
-- implementation of s-tposen, which was initially created for
|
||||||
|
-- the Ravenscar profile.
|
||||||
|
|
||||||
case Corresponding_Runtime_Package (Conc_Typ) is
|
case Corresponding_Runtime_Package (Conc_Typ) is
|
||||||
when System_Tasking_Protected_Objects_Entries =>
|
when System_Tasking_Protected_Objects_Entries =>
|
||||||
Append_To (Stmts,
|
Append_To (Stmts,
|
||||||
|
|
|
@ -150,14 +150,14 @@ package body System.Tasking.Stages is
|
||||||
C : Task_Id;
|
C : Task_Id;
|
||||||
P : Task_Id;
|
P : Task_Id;
|
||||||
|
|
||||||
-- Each task C will take care of its own dependents, so there is no need
|
-- Each task C will take care of its own dependents, so there is no
|
||||||
-- to worry about them here. In fact, it would be wrong to abort
|
-- need to worry about them here. In fact, it would be wrong to abort
|
||||||
-- indirect dependents here, because we can't distinguish between
|
-- indirect dependents here, because we can't distinguish between
|
||||||
-- duplicate master ids. For example, suppose we have three nested task
|
-- duplicate master ids. For example, suppose we have three nested
|
||||||
-- bodies T1,T2,T3. And suppose T1 also calls P which calls Q (and both
|
-- task bodies T1,T2,T3. And suppose T1 also calls P which calls Q (and
|
||||||
-- P and Q are task masters). Q will have the same master id as
|
-- both P and Q are task masters). Q will have the same master id as
|
||||||
-- Master_of_Task of T3. Previous versions of this would abort T3 when Q
|
-- Master_of_Task of T3. Previous versions of this would abort T3 when
|
||||||
-- calls Complete_Master, which was completely wrong.
|
-- Q calls Complete_Master, which was completely wrong.
|
||||||
|
|
||||||
begin
|
begin
|
||||||
C := All_Tasks_List;
|
C := All_Tasks_List;
|
||||||
|
|
|
@ -54,7 +54,7 @@ pragma Style_Checks (All_Checks);
|
||||||
|
|
||||||
pragma Polling (Off);
|
pragma Polling (Off);
|
||||||
-- Turn off polling, we do not want polling to take place during tasking
|
-- Turn off polling, we do not want polling to take place during tasking
|
||||||
-- operations. It can cause infinite loops and other problems.
|
-- operations. It can cause infinite loops and other problems.
|
||||||
|
|
||||||
pragma Suppress (All_Checks);
|
pragma Suppress (All_Checks);
|
||||||
-- Why is this required ???
|
-- Why is this required ???
|
||||||
|
@ -84,10 +84,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
|
|
||||||
procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link);
|
procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link);
|
||||||
pragma Inline (Wakeup_Entry_Caller);
|
pragma Inline (Wakeup_Entry_Caller);
|
||||||
-- This is called at the end of service of an entry call,
|
-- This is called at the end of service of an entry call, to abort the
|
||||||
-- to abort the caller if he is in an abortable part, and
|
-- caller if he is in an abortable part, and to wake up the caller if he
|
||||||
-- to wake up the caller if he is on Entry_Caller_Sleep.
|
-- is on Entry_Caller_Sleep. Call it holding the lock of Entry_Call.Self.
|
||||||
-- Call it holding the lock of Entry_Call.Self.
|
|
||||||
|
|
||||||
procedure Wait_For_Completion (Entry_Call : Entry_Call_Link);
|
procedure Wait_For_Completion (Entry_Call : Entry_Call_Link);
|
||||||
pragma Inline (Wait_For_Completion);
|
pragma Inline (Wait_For_Completion);
|
||||||
|
@ -100,17 +99,16 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
(Self_ID : Task_Id;
|
(Self_ID : Task_Id;
|
||||||
Entry_Call : Entry_Call_Link);
|
Entry_Call : Entry_Call_Link);
|
||||||
pragma Inline (Check_Exception);
|
pragma Inline (Check_Exception);
|
||||||
-- Raise any pending exception from the Entry_Call.
|
-- Raise any pending exception from the Entry_Call. This should be called
|
||||||
-- This should be called at the end of every compiler interface procedure
|
-- at the end of every compiler interface procedure that implements an
|
||||||
-- that implements an entry call.
|
-- entry call. The caller should not be holding any locks, or there will
|
||||||
-- The caller should not be holding any locks, or there will be deadlock.
|
-- be deadlock.
|
||||||
|
|
||||||
procedure PO_Do_Or_Queue
|
procedure PO_Do_Or_Queue
|
||||||
(Object : Protection_Entry_Access;
|
(Object : Protection_Entry_Access;
|
||||||
Entry_Call : Entry_Call_Link);
|
Entry_Call : Entry_Call_Link);
|
||||||
-- This procedure executes or queues an entry call, depending
|
-- This procedure executes or queues an entry call, depending on the status
|
||||||
-- on the status of the corresponding barrier. It assumes that the
|
-- of the corresponding barrier. The specified object is assumed locked.
|
||||||
-- specified object is locked.
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
-- Check_Exception --
|
-- Check_Exception --
|
||||||
|
@ -140,9 +138,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
-- Send_Program_Error --
|
-- Send_Program_Error --
|
||||||
------------------------
|
------------------------
|
||||||
|
|
||||||
procedure Send_Program_Error (Entry_Call : Entry_Call_Link)
|
procedure Send_Program_Error (Entry_Call : Entry_Call_Link) is
|
||||||
is
|
|
||||||
Caller : constant Task_Id := Entry_Call.Self;
|
Caller : constant Task_Id := Entry_Call.Self;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Entry_Call.Exception_To_Raise := Program_Error'Identity;
|
Entry_Call.Exception_To_Raise := Program_Error'Identity;
|
||||||
|
|
||||||
|
@ -192,7 +190,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
pragma Assert
|
pragma Assert
|
||||||
(Caller.Common.State /= Terminated and then
|
(Caller.Common.State /= Terminated and then
|
||||||
Caller.Common.State /= Unactivated);
|
Caller.Common.State /= Unactivated);
|
||||||
|
|
||||||
Entry_Call.State := Done;
|
Entry_Call.State := Done;
|
||||||
STPO.Wakeup (Caller, Entry_Caller_Sleep);
|
STPO.Wakeup (Caller, Entry_Caller_Sleep);
|
||||||
end Wakeup_Entry_Caller;
|
end Wakeup_Entry_Caller;
|
||||||
|
@ -207,7 +204,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
|
|
||||||
procedure Exceptional_Complete_Single_Entry_Body
|
procedure Exceptional_Complete_Single_Entry_Body
|
||||||
(Object : Protection_Entry_Access;
|
(Object : Protection_Entry_Access;
|
||||||
Ex : Ada.Exceptions.Exception_Id) is
|
Ex : Ada.Exceptions.Exception_Id)
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
Object.Call_In_Progress.Exception_To_Raise := Ex;
|
Object.Call_In_Progress.Exception_To_Raise := Ex;
|
||||||
end Exceptional_Complete_Single_Entry_Body;
|
end Exceptional_Complete_Single_Entry_Body;
|
||||||
|
@ -235,7 +233,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
-- Lock_Entry --
|
-- Lock_Entry --
|
||||||
----------------
|
----------------
|
||||||
|
|
||||||
-- Compiler interface only.
|
-- Compiler interface only
|
||||||
|
|
||||||
-- Do not call this procedure from within the run-time system.
|
-- Do not call this procedure from within the run-time system.
|
||||||
|
|
||||||
procedure Lock_Entry (Object : Protection_Entry_Access) is
|
procedure Lock_Entry (Object : Protection_Entry_Access) is
|
||||||
|
@ -391,7 +390,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||||
-----------------------------------
|
-----------------------------------
|
||||||
|
|
||||||
function Protected_Single_Entry_Caller
|
function Protected_Single_Entry_Caller
|
||||||
(Object : Protection_Entry) return Task_Id is
|
(Object : Protection_Entry) return Task_Id
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Object.Call_In_Progress.Self;
|
return Object.Call_In_Progress.Self;
|
||||||
end Protected_Single_Entry_Caller;
|
end Protected_Single_Entry_Caller;
|
||||||
|
|
|
@ -228,7 +228,7 @@ package System.Tasking.Protected_Objects.Single_Entry is
|
||||||
Uninterpreted_Data : System.Address);
|
Uninterpreted_Data : System.Address);
|
||||||
-- Make a protected entry call to the specified object
|
-- Make a protected entry call to the specified object
|
||||||
--
|
--
|
||||||
-- Pend a protected entry call on the protected object represented by
|
-- Pends a protected entry call on the protected object represented by
|
||||||
-- Object. A pended call is not queued; it may be executed immediately
|
-- Object. A pended call is not queued; it may be executed immediately
|
||||||
-- or queued, depending on the state of the entry barrier.
|
-- or queued, depending on the state of the entry barrier.
|
||||||
--
|
--
|
||||||
|
|
|
@ -4244,7 +4244,10 @@ package body Sem_Warn is
|
||||||
|
|
||||||
procedure Warn_On_Useless_Assignments (E : Entity_Id) is
|
procedure Warn_On_Useless_Assignments (E : Entity_Id) is
|
||||||
Ent : Entity_Id;
|
Ent : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Process_Deferred_References;
|
||||||
|
|
||||||
if Warn_On_Modified_Unread
|
if Warn_On_Modified_Unread
|
||||||
and then In_Extended_Main_Source_Unit (E)
|
and then In_Extended_Main_Source_Unit (E)
|
||||||
then
|
then
|
||||||
|
|
Loading…
Reference in New Issue