OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,
	s-interr-hwint.adb, s-tpobop.adb, sem_ch13.adb: Minor reformatting.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* par-endh.adb (Check_End): For an END where it is mandatory to repeat
	the scope name, do not report a missing label as a style violation (it
	will be diagnosed as an illegality).
	* exp_dist.adb (Add_Params_For_Variant_Components): Fix handling of
	variant records: Get_Enum_Lit_From_Pos already returns a usage
	occurrence of the literal, no need to use New_Occurrence_Of. Set Etype
	on Expr in Integer_Literal case so that it can be used by
	Build_To_Any_Call.

From-SVN: r178195
This commit is contained in:
Arnaud Charlet 2011-08-29 12:36:46 +02:00
parent 1d10f669bc
commit cb25faf861
11 changed files with 153 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2011-08-29 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,
s-interr-hwint.adb, s-tpobop.adb, sem_ch13.adb: Minor reformatting.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* par-endh.adb (Check_End): For an END where it is mandatory to repeat
the scope name, do not report a missing label as a style violation (it
will be diagnosed as an illegality).
* exp_dist.adb (Add_Params_For_Variant_Components): Fix handling of
variant records: Get_Enum_Lit_From_Pos already returns a usage
occurrence of the literal, no need to use New_Occurrence_Of. Set Etype
on Expr in Integer_Literal case so that it can be used by
Build_To_Any_Call.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_sel.ads (Build_Abort_BLock_Handler): New function spec.

1
gcc/ada/exp_ch11.adb
View File

@ -1100,7 +1100,6 @@ package body Exp_Ch11 is
elsif Abort_Allowed
and then Exception_Mechanism /= Back_End_Exceptions
then
-- There are some special cases in which we do not do the
-- undefer. In particular a finalization (AT END) handler
-- wants to operate with aborts still deferred.

13
gcc/ada/exp_ch9.adb
View File

@ -6487,8 +6487,7 @@ package body Exp_Ch9 is
Append_To (Stmts,
Make_Implicit_If_Statement (N,
Condition => Make_Function_Call (Loc,
Name => New_Reference_To (
RTE (RE_Enqueued), Loc),
Name => New_Reference_To (RTE (RE_Enqueued), Loc),
Parameter_Associations => New_List (
New_Reference_To (Cancel_Param, Loc))),
Then_Statements => Astats));
@ -6507,9 +6506,12 @@ package body Exp_Ch9 is
if VM_Target = No_VM then
if Exception_Mechanism = Back_End_Exceptions then
-- Aborts are not deferred at beginning of exception handlers
-- in ZCX.
Handler_Stmt := Make_Null_Statement (Loc);
else
Handler_Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
@ -6518,9 +6520,10 @@ package body Exp_Ch9 is
else
Handler_Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Update_Exception), Loc),
Parameter_Associations => New_List (Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Current_Target_Exception),
Loc))));
Parameter_Associations => New_List (
Make_Function_Call (Loc,
Name => New_Occurrence_Of
(RTE (RE_Current_Target_Exception), Loc))));
end if;
Stmts := New_List (

43
gcc/ada/exp_dist.adb
View File

@ -10430,11 +10430,10 @@ package body Exp_Dist is
-- A variant part
declare
Discriminant_Type : constant Entity_Id :=
Etype (Name (Field));
Disc_Type : constant Entity_Id := Etype (Name (Field));
Is_Enum : constant Boolean :=
Is_Enumeration_Type (Discriminant_Type);
Is_Enumeration_Type (Disc_Type);
Union_TC_Params : List_Id;
@ -10465,8 +10464,7 @@ package body Exp_Dist is
-- Add_Params_For_Variant_Components --
---------------------------------------
procedure Add_Params_For_Variant_Components
is
procedure Add_Params_For_Variant_Components is
S_Name : constant Name_Id :=
New_External_Name (U_Name, 'S', -1);
@ -10510,8 +10508,7 @@ package body Exp_Dist is
-- Build union parameters
Add_TypeCode_Parameter
(Build_TypeCode_Call
(Loc, Discriminant_Type, Decls),
(Build_TypeCode_Call (Loc, Disc_Type, Decls),
Union_TC_Params);
Add_Long_Parameter (Default, Union_TC_Params);
@ -10536,13 +10533,13 @@ package body Exp_Dist is
begin
while J <= H loop
if Is_Enum then
Expr := New_Occurrence_Of (
Get_Enum_Lit_From_Pos (
Discriminant_Type, J, Loc), Loc);
Expr := Get_Enum_Lit_From_Pos
(Disc_Type, J, Loc);
else
Expr :=
Make_Integer_Literal (Loc, J);
end if;
Set_Etype (Expr, Disc_Type);
Append_To (Union_TC_Params,
Build_To_Any_Call (Expr, Decls));
@ -10553,11 +10550,10 @@ package body Exp_Dist is
when N_Others_Choice =>
-- This variant possess a default choice.
-- We must therefore set the default
-- parameter to the current choice index. The
-- default parameter is by construction the
-- fourth in the Union_TC_Params list.
-- This variant has a default choice. We must
-- therefore set the default parameter to the
-- current choice index. This parameter is by
-- construction the 4th in Union_TC_Params.
declare
Default_Node : constant Node_Id :=
@ -10573,25 +10569,24 @@ package body Exp_Dist is
Make_Integer_Literal
(Loc, Choice_Index)));
begin
Insert_Before (
Default_Node,
New_Default_Node);
Insert_Before
(Default_Node, New_Default_Node);
Remove (Default_Node);
end;
-- Add a placeholder member label
-- for the default case.
-- It must be of the discriminant type.
-- Add a placeholder member label for the
-- default case, which must have the
-- discriminant type.
declare
Exp : constant Node_Id :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of
(Discriminant_Type, Loc),
Prefix => New_Occurrence_Of
(Disc_Type, Loc),
Attribute_Name => Name_First);
begin
Set_Etype (Exp, Discriminant_Type);
Set_Etype (Exp, Disc_Type);
Append_To (Union_TC_Params,
Build_To_Any_Call (Exp, Decls));
end;

29
gcc/ada/exp_sel.adb
View File

@ -57,10 +57,8 @@ package body Exp_Sel is
Statements =>
New_List (
Make_Implicit_Label_Declaration (Loc,
Defining_Identifier =>
Cln_Blk_Ent,
Label_Construct =>
Blk),
Defining_Identifier => Cln_Blk_Ent,
Label_Construct => Blk),
Blk),
Exception_Handlers =>
@ -71,29 +69,29 @@ package body Exp_Sel is
-- Build_Abort_Block_Handler --
-------------------------------
function Build_Abort_Block_Handler
(Loc : Source_Ptr) return Node_Id
is
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id is
Stmt : Node_Id;
begin
if Exception_Mechanism = Back_End_Exceptions then
-- With ZCX, aborts are not defered in handlers.
-- With ZCX, aborts are not defered in handlers
Stmt := Make_Null_Statement (Loc);
else
-- With FE SJLJ, aborts are defered at the beginning of Abort_Signal
-- handlers.
Stmt := Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
Stmt :=
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
end if;
return Make_Implicit_Exception_Handler (Loc,
Exception_Choices =>
New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
Statements =>
New_List (Stmt));
Statements => New_List (Stmt));
end Build_Abort_Block_Handler;
-------------
@ -143,8 +141,9 @@ package body Exp_Sel is
is
Cleanup_Block : constant Node_Id :=
Make_Block_Statement (Loc,
Identifier => New_Reference_To (Blk_Ent, Loc),
Declarations => No_List,
Identifier =>
New_Reference_To (Blk_Ent, Loc),
Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stmts),

3
gcc/ada/exp_sel.ads
View File

@ -45,8 +45,7 @@ package Exp_Sel is
-- of the encapsulated cleanup block, Blk is the actual block name.
-- The exception handler code is built by Build_Abort_Block_Handler.
function Build_Abort_Block_Handler
(Loc : Source_Ptr) return Node_Id;
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
-- Generate if front-end exception:
-- when others =>
-- Abort_Under;

7
gcc/ada/par-endh.adb
View File

@ -374,11 +374,16 @@ package body Endh is
Set_Comes_From_Source (End_Labl, False);
End_Labl_Present := False;
-- Do style check for missing label
-- Do style check for label permitted but not present. Note:
-- for the case of a block statement, the label is required
-- to be repeated, and this legality rule is enforced
-- independently.
if Style_Check
and then End_Type = E_Name
and then Explicit_Start_Label (Scope.Last)
and then Nkind (Parent (Scope.Table (Scope.Last).Labl))
/= N_Block_Statement
then
Style.No_End_Name (Scope.Table (Scope.Last).Labl);
end if;

1
gcc/ada/s-interr-hwint.adb
View File

@ -1030,6 +1030,7 @@ package body System.Interrupts is
end if;
-- Flush interrupt server semaphores, so they can terminate
Finalize_Interrupt_Servers;
raise;
end Interrupt_Manager;

154
gcc/ada/s-tasren.adb
View File

@ -97,16 +97,15 @@ package body System.Tasking.Rendezvous is
procedure Local_Undefer_Abort (Self_Id : Task_Id) renames
System.Tasking.Initialization.Undefer_Abort_Nestable;
-- Florist defers abort around critical sections that
-- make entry calls to the Interrupt_Manager task, which
-- violates the general rule about top-level runtime system
-- calls from abort-deferred regions. It is not that this is
-- unsafe, but when it occurs in "normal" programs it usually
-- means either the user is trying to do a potentially blocking
-- operation from within a protected object, or there is a
-- runtime system/compiler error that has failed to undefer
-- an earlier abort deferral. Thus, for debugging it may be
-- wise to modify the above renamings to the non-nestable forms.
-- Florist defers abort around critical sections that make entry calls
-- to the Interrupt_Manager task, which violates the general rule about
-- top-level runtime system calls from abort-deferred regions. It is not
-- that this is unsafe, but when it occurs in "normal" programs it usually
-- means either the user is trying to do a potentially blocking operation
-- from within a protected object, or there is a runtime system/compiler
-- error that has failed to undefer an earlier abort deferral. Thus, for
-- debugging it may be wise to modify the above renamings to the
-- non-nestable forms.
procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
pragma Inline (Boost_Priority);
@ -126,18 +125,17 @@ package body System.Tasking.Rendezvous is
(Entry_Call : Entry_Call_Link;
Acceptor : Task_Id);
pragma Inline (Setup_For_Rendezvous_With_Body);
-- Call this only with abort deferred and holding lock of Acceptor.
-- When a rendezvous selected (ready for rendezvous) we need to save
-- previous caller and adjust the priority. Also we need to make
-- this call not Abortable (Cancellable) since the rendezvous has
-- already been started.
-- Call this only with abort deferred and holding lock of Acceptor. When
-- a rendezvous selected (ready for rendezvous) we need to save previous
-- caller and adjust the priority. Also we need to make this call not
-- Abortable (Cancellable) since the rendezvous has already been started.
procedure Wait_For_Call (Self_Id : Task_Id);
pragma Inline (Wait_For_Call);
-- Call this only with abort deferred and holding lock of Self_Id.
-- An accepting task goes into Sleep by calling this routine
-- waiting for a call from the caller or waiting for an abort.
-- Make sure Self_Id is locked before calling this routine.
-- Call this only with abort deferred and holding lock of Self_Id. An
-- accepting task goes into Sleep by calling this routine waiting for a
-- call from the caller or waiting for an abort. Make sure Self_Id is
-- locked before calling this routine.
-----------------
-- Accept_Call --
@ -148,7 +146,7 @@ package body System.Tasking.Rendezvous is
Uninterpreted_Data : out System.Address)
is
Self_Id : constant Task_Id := STPO.Self;
Caller : Task_Id := null;
Caller : Task_Id := null;
Open_Accepts : aliased Accept_List (1 .. 1);
Entry_Call : Entry_Call_Link;
@ -217,8 +215,8 @@ package body System.Tasking.Rendezvous is
end if;
end if;
-- Self_Id.Common.Call should already be updated by the Caller
-- On return, we will start the rendezvous.
-- Self_Id.Common.Call should already be updated by the Caller. On
-- return, we will start the rendezvous.
STPO.Unlock (Self_Id);
@ -239,7 +237,7 @@ package body System.Tasking.Rendezvous is
procedure Accept_Trivial (E : Task_Entry_Index) is
Self_Id : constant Task_Id := STPO.Self;
Caller : Task_Id := null;
Caller : Task_Id := null;
Open_Accepts : aliased Accept_List (1 .. 1);
Entry_Call : Entry_Call_Link;
@ -274,6 +272,7 @@ package body System.Tasking.Rendezvous is
Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
if Entry_Call = null then
-- Need to wait for entry call
Open_Accepts (1).Null_Body := True;
@ -296,7 +295,9 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
else -- found caller already waiting
-- Found caller already waiting
else
pragma Assert (Entry_Call.State < Done);
STPO.Unlock (Self_Id);
@ -310,8 +311,8 @@ package body System.Tasking.Rendezvous is
if Parameters.Runtime_Traces then
Send_Trace_Info (M_Accept_Complete);
-- Fake one, since there is (???) no way
-- to know that the rendezvous is over
-- Fake one, since there is (???) no way to know that the rendezvous
-- is over.
Send_Trace_Info (M_RDV_Complete);
end if;
@ -328,15 +329,13 @@ package body System.Tasking.Rendezvous is
--------------------
procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id) is
Caller : constant Task_Id := Call.Self;
Caller : constant Task_Id := Call.Self;
Caller_Prio : constant System.Any_Priority := Get_Priority (Caller);
Acceptor_Prio : constant System.Any_Priority := Get_Priority (Acceptor);
begin
if Caller_Prio > Acceptor_Prio then
Call.Acceptor_Prev_Priority := Acceptor_Prio;
Set_Priority (Acceptor, Caller_Prio);
else
Call.Acceptor_Prev_Priority := Priority_Not_Boosted;
end if;
@ -530,23 +529,23 @@ package body System.Tasking.Rendezvous is
use type STPE.Protection_Entries_Access;
begin
-- Consider phasing out Complete_Rendezvous in favor
-- of direct call to this with Ada.Exceptions.Null_ID.
-- See code expansion examples for Accept_Call and Selective_Wait.
-- Also consider putting an explicit re-raise after this call, in
-- the generated code. That way we could eliminate the
-- code here that reraises the exception.
-- Consider phasing out Complete_Rendezvous in favor of direct call to
-- this with Ada.Exceptions.Null_ID. See code expansion examples for
-- Accept_Call and Selective_Wait. Also consider putting an explicit
-- re-raise after this call, in the generated code. That way we could
-- eliminate the code here that reraises the exception.
-- The deferral level is critical here,
-- since we want to raise an exception or allow abort to take
-- place, if there is an exception or abort pending.
-- The deferral level is critical here, since we want to raise an
-- exception or allow abort to take place, if there is an exception or
-- abort pending.
pragma Debug
(Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R'));
if Ex = Ada.Exceptions.Null_Id then
-- The call came from normal end-of-rendezvous,
-- so abort is not yet deferred.
-- The call came from normal end-of-rendezvous, so abort is not yet
-- deferred.
if Parameters.Runtime_Traces then
Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
@ -555,13 +554,14 @@ package body System.Tasking.Rendezvous is
Initialization.Defer_Abort_Nestable (Self_Id);
elsif ZCX_By_Default then
-- With ZCX, aborts are not automatically deferred in handlers
Initialization.Defer_Abort_Nestable (Self_Id);
end if;
-- We need to clean up any accepts which Self may have
-- been serving when it was aborted.
-- We need to clean up any accepts which Self may have been serving when
-- it was aborted.
if Ex = Standard'Abort_Signal'Identity then
if Single_Lock then
@ -579,8 +579,8 @@ package body System.Tasking.Rendezvous is
Caller := Entry_Call.Self;
-- Take write lock. This follows the lock precedence rule that
-- Caller may be locked while holding lock of Acceptor.
-- Complete the call abnormally, with exception.
-- Caller may be locked while holding lock of Acceptor. Complete
-- the call abnormally, with exception.
STPO.Write_Lock (Caller);
Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
@ -596,13 +596,15 @@ package body System.Tasking.Rendezvous is
Caller := Entry_Call.Self;
if Entry_Call.Needs_Requeue then
-- We dare not lock Self_Id at the same time as Caller,
-- for fear of deadlock.
-- We dare not lock Self_Id at the same time as Caller, for fear
-- of deadlock.
Entry_Call.Needs_Requeue := False;
Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
if Entry_Call.Called_Task /= null then
-- Requeue to another task entry
if Single_Lock then
@ -698,6 +700,7 @@ package body System.Tasking.Rendezvous is
-- ??? Do we need to give precedence to Program_Error that might be
-- raised due to failure of finalization, over Tasking_Error from
-- failure of requeue?
end Exceptional_Complete_Rendezvous;
-------------------------------------
@ -732,7 +735,6 @@ package body System.Tasking.Rendezvous is
is
Self_Id : constant Task_Id := STPO.Self;
Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
begin
Initialization.Defer_Abort (Self_Id);
Entry_Call.Needs_Requeue := True;
@ -826,6 +828,7 @@ package body System.Tasking.Rendezvous is
case Treatment is
when Accept_Alternative_Selected =>
-- Ready to rendezvous
Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
@ -907,6 +910,7 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
when Terminate_Selected =>
-- Terminate alternative is open
Self_Id.Open_Accepts := Open_Accepts;
@ -925,13 +929,12 @@ package body System.Tasking.Rendezvous is
pragma Assert (Self_Id.Open_Accepts = null);
if Self_Id.Terminate_Alternative then
-- An entry call should have reset this to False,
-- so we must be aborted.
-- We cannot be in an async. select, since that
-- is not legal, so the abort must be of the entire
-- task. Therefore, we do not need to cancel the
-- terminate alternative. The cleanup will be done
-- in Complete_Master.
-- An entry call should have reset this to False, so we must be
-- aborted. We cannot be in an async. select, since that is not
-- legal, so the abort must be of the entire task. Therefore,
-- we do not need to cancel the terminate alternative. The
-- cleanup will be done in Complete_Master.
pragma Assert (Self_Id.Pending_ATC_Level = 0);
pragma Assert (Self_Id.Awake_Count = 0);
@ -972,6 +975,7 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
when No_Alternative_Open =>
-- In this case, Index will be No_Rendezvous on return, which
-- should cause a Program_Error if it is not a Delay_Mode.
@ -1008,10 +1012,13 @@ package body System.Tasking.Rendezvous is
Unlock_RTS;
end if;
-- Caller has been chosen.
-- Caller has been chosen
-- Self_Id.Common.Call should already be updated by the Caller.
-- Self_Id.Chosen_Index should either be updated by the Caller
-- or by Test_Selective_Wait.
-- On return, we sill start rendezvous unless the accept body is
-- null. In the latter case, we will have already completed the RV.
@ -1087,10 +1094,10 @@ package body System.Tasking.Rendezvous is
begin
-- Find out whether Entry_Call can be accepted immediately
-- If the Acceptor is not callable, return False.
-- If the rendezvous can start, initiate it.
-- If the accept-body is trivial, also complete the rendezvous.
-- If the acceptor is not ready, enqueue the call.
-- If the Acceptor is not callable, return False.
-- If the rendezvous can start, initiate it.
-- If the accept-body is trivial, also complete the rendezvous.
-- If the acceptor is not ready, enqueue the call.
-- This should have a special case for Accept_Call and Accept_Trivial,
-- so that we don't have the loop setup overhead, below.
@ -1364,12 +1371,12 @@ package body System.Tasking.Rendezvous is
raise Tasking_Error;
end if;
-- The following is special for async. entry calls.
-- If the call was not queued abortably, we need to wait until
-- it is before proceeding with the abortable part.
-- The following is special for async. entry calls. If the call was
-- not queued abortably, we need to wait until it is before
-- proceeding with the abortable part.
-- Wait_Until_Abortable can be called unconditionally here,
-- but it is expensive.
-- Wait_Until_Abortable can be called unconditionally here, but it is
-- expensive.
if Entry_Call.State < Was_Abortable then
Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
@ -1490,15 +1497,16 @@ package body System.Tasking.Rendezvous is
case Treatment is
when Accept_Alternative_Selected =>
-- Ready to rendezvous
-- In this case the accept body is not Null_Body. Defer abort
-- until it gets into the accept body.
-- Ready to rendezvous. In this case the accept body is not
-- Null_Body. Defer abort until it gets into the accept body.
Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
Initialization.Defer_Abort (Self_Id);
STPO.Unlock (Self_Id);
when Accept_Alternative_Completed =>
-- Rendezvous is over
if Parameters.Runtime_Traces then
@ -1599,14 +1607,16 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
when No_Alternative_Open =>
-- In this case, Index will be No_Rendezvous on return. We sleep
-- for the time we need to.
-- Wait for a signal or timeout. A wakeup can be made
-- for several reasons:
-- 1) Delay is expired
-- 2) Pending_Action needs to be checked
-- (Abort, Priority change)
-- 3) Spurious wakeup
-- 1) Delay is expired
-- 2) Pending_Action needs to be checked
-- (Abort, Priority change)
-- 3) Spurious wakeup
Self_Id.Open_Accepts := null;
Self_Id.Common.State := Acceptor_Delay_Sleep;
@ -1619,7 +1629,9 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
when others =>
-- Should never get here
pragma Assert (False);
null;
end case;

4
gcc/ada/s-tpobop.adb
View File

@ -258,9 +258,11 @@ package body System.Tasking.Protected_Objects.Operations is
-- enabled for its remaining life.
Self_Id := STPO.Self;
if not ZCX_By_Default then
Initialization.Undefer_Abort_Nestable (Self_Id);
end if;
Transfer_Occurrence
(Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
Self_Id.Common.Compiler_Data.Current_Excep);
@ -272,7 +274,9 @@ package body System.Tasking.Protected_Objects.Operations is
end if;
if Runtime_Traces then
-- ??? Entry_Call can be null
Send_Trace_Info (PO_Done, Entry_Call.Self);
end if;
end Exceptional_Complete_Entry_Body;

2
gcc/ada/sem_ch13.adb
View File

@ -1544,7 +1544,7 @@ package body Sem_Ch13 is
-- has the proper type structure.
function Check_Primitive_Function (Subp : Entity_Id) return Boolean;
-- Common legality check for the previoous two
-- Common legality check for the previous two
-----------------------------------
-- Analyze_Stream_TSS_Definition --