Commit bdfb8ec4 by Arnaud Charlet

[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
parent 5b0e6852
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 ...@@ -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.
......
...@@ -3522,6 +3522,13 @@ package body Exp_Disp is ...@@ -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 ...@@ -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); ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment