Commit 9d08a38d by Thomas Quinot Committed by Arnaud Charlet

exp_ch9.adb (Ensure_Statement_Present): New subprogram.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Ensure_Statement_Present): New subprogram.
	(Expand_N_Asynchronous_Select,
	Expand_N_Selective_Accept.Process_Accept_Alternative,
	Expand_N_Selective_Accept.Process_Delay_Alternative,
	Expand_N_Timed_Entry_Call): For an alternative with no trailing
	statements, introduce a null statement to carry the sloc of
	the initial special statement (accept, delay, or entry call)
	in the alternative, for coverage analysis purposes.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* sem_eval.adb (In_Subrange_Of): Fix typo in test for scalar
	arguments.

From-SVN: r189535
parent 70805b88
2012-07-16 Thomas Quinot <quinot@adacore.com>
* exp_ch9.adb (Ensure_Statement_Present): New subprogram.
(Expand_N_Asynchronous_Select,
Expand_N_Selective_Accept.Process_Accept_Alternative,
Expand_N_Selective_Accept.Process_Delay_Alternative,
Expand_N_Timed_Entry_Call): For an alternative with no trailing
statements, introduce a null statement to carry the sloc of
the initial special statement (accept, delay, or entry call)
in the alternative, for coverage analysis purposes.
2012-07-16 Thomas Quinot <quinot@adacore.com>
* sem_eval.adb (In_Subrange_Of): Fix typo in test for scalar
arguments.
2012-07-16 Robert Dewar <dewar@adacore.com> 2012-07-16 Robert Dewar <dewar@adacore.com>
* a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb, * a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb,
......
...@@ -339,6 +339,17 @@ package body Exp_Ch9 is ...@@ -339,6 +339,17 @@ package body Exp_Ch9 is
-- step of the expansion must to be done after private data has been moved -- step of the expansion must to be done after private data has been moved
-- to its final resting scope to ensure proper visibility of debug objects. -- to its final resting scope to ensure proper visibility of debug objects.
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id);
-- If control flow optimizations are suppressed, and Alt is an accept,
-- delay, or entry call alternative with no trailing statements, insert a
-- null trailing statement with the given Loc (which is the sloc of the
-- accept, delay, or entry call statement). There might not be any
-- generated code for the accept, delay, or entry call itself (the
-- effect of these statements is part of the general processsing done
-- for the enclosing selective accept, timed entry call, or asynchronous
-- select), and the null statement is there to carry the sloc of that
-- statement to the back-end for trace-based coverage analysis purposes.
procedure Extract_Dispatching_Call procedure Extract_Dispatching_Call
(N : Node_Id; (N : Node_Id;
Call_Ent : out Entity_Id; Call_Ent : out Entity_Id;
...@@ -5468,6 +5479,19 @@ package body Exp_Ch9 is ...@@ -5468,6 +5479,19 @@ package body Exp_Ch9 is
end loop; end loop;
end Debug_Private_Data_Declarations; end Debug_Private_Data_Declarations;
------------------------------
-- Ensure_Statement_Present --
------------------------------
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
begin
if Opt.Suppress_Control_Flow_Optimizations
and then Is_Empty_List (Statements (Alt))
then
Set_Statements (Alt, New_List (Make_Null_Statement (Loc)));
end if;
end Ensure_Statement_Present;
---------------------------- ----------------------------
-- Entry_Index_Expression -- -- Entry_Index_Expression --
---------------------------- ----------------------------
...@@ -6587,7 +6611,7 @@ package body Exp_Ch9 is ...@@ -6587,7 +6611,7 @@ package body Exp_Ch9 is
Abortable_Block : Node_Id; Abortable_Block : Node_Id;
Actuals : List_Id; Actuals : List_Id;
Astats : List_Id; Astats : List_Id;
Blk_Ent : Entity_Id; Blk_Ent : constant Entity_Id := Make_Temporary (Loc, 'A');
Blk_Typ : Entity_Id; Blk_Typ : Entity_Id;
Call : Node_Id; Call : Node_Id;
Call_Ent : Entity_Id; Call_Ent : Entity_Id;
...@@ -6632,15 +6656,16 @@ package body Exp_Ch9 is ...@@ -6632,15 +6656,16 @@ package body Exp_Ch9 is
Process_Statements_For_Controlled_Objects (Trig); Process_Statements_For_Controlled_Objects (Trig);
Process_Statements_For_Controlled_Objects (Abrt); Process_Statements_For_Controlled_Objects (Abrt);
Ecall := Triggering_Statement (Trig);
Ensure_Statement_Present (Sloc (Ecall), Trig);
-- Retrieve Astats and Tstats now because the finalization machinery may -- Retrieve Astats and Tstats now because the finalization machinery may
-- wrap them in blocks. -- wrap them in blocks.
Astats := Statements (Abrt); Astats := Statements (Abrt);
Tstats := Statements (Trig); Tstats := Statements (Trig);
Blk_Ent := Make_Temporary (Loc, 'A');
Ecall := Triggering_Statement (Trig);
-- The arguments in the call may require dynamic allocation, and the -- The arguments in the call may require dynamic allocation, and the
-- call statement may have been transformed into a block. The block -- call statement may have been transformed into a block. The block
-- may contain additional declarations for internal entities, and the -- may contain additional declarations for internal entities, and the
...@@ -10301,6 +10326,8 @@ package body Exp_Ch9 is ...@@ -10301,6 +10326,8 @@ package body Exp_Ch9 is
Alt_Stats := New_List; Alt_Stats := New_List;
end if; end if;
Ensure_Statement_Present (Sloc (Astmt), Alt);
-- After the call, if any, branch to trailing statements, if any. -- After the call, if any, branch to trailing statements, if any.
-- We create a label for each, as well as the corresponding label -- We create a label for each, as well as the corresponding label
-- declaration. -- declaration.
...@@ -10330,6 +10357,7 @@ package body Exp_Ch9 is ...@@ -10330,6 +10357,7 @@ package body Exp_Ch9 is
------------------------------- -------------------------------
procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int) is procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int) is
Dloc : constant Source_Ptr := Sloc (Delay_Statement (Alt));
Choices : List_Id; Choices : List_Id;
Cond : Node_Id; Cond : Node_Id;
Delay_Alt : List_Id; Delay_Alt : List_Id;
...@@ -10433,6 +10461,8 @@ package body Exp_Ch9 is ...@@ -10433,6 +10461,8 @@ package body Exp_Ch9 is
Append_List (Delay_Alt, Delay_List); Append_List (Delay_Alt, Delay_List);
Ensure_Statement_Present (Dloc, Alt);
-- If the delay alternative has a statement part, add choice to the -- If the delay alternative has a statement part, add choice to the
-- case statements for delays. -- case statements for delays.
...@@ -11884,6 +11914,8 @@ package body Exp_Ch9 is ...@@ -11884,6 +11914,8 @@ package body Exp_Ch9 is
Process_Statements_For_Controlled_Objects (E_Alt); Process_Statements_For_Controlled_Objects (E_Alt);
Process_Statements_For_Controlled_Objects (D_Alt); Process_Statements_For_Controlled_Objects (D_Alt);
Ensure_Statement_Present (Sloc (D_Stat), D_Alt);
-- Retrieve E_Stats and D_Stats now because the finalization machinery -- Retrieve E_Stats and D_Stats now because the finalization machinery
-- may wrap them in blocks. -- may wrap them in blocks.
......
...@@ -4154,7 +4154,7 @@ package body Sem_Eval is ...@@ -4154,7 +4154,7 @@ package body Sem_Eval is
-- Never in range if both types are not scalar. Don't know if this can -- Never in range if both types are not scalar. Don't know if this can
-- actually happen, but just in case. -- actually happen, but just in case.
elsif not Is_Scalar_Type (T1) or else not Is_Scalar_Type (T1) then elsif not Is_Scalar_Type (T1) or else not Is_Scalar_Type (T2) then
return False; return False;
-- If T1 has infinities but T2 doesn't have infinities, then T1 is -- If T1 has infinities but T2 doesn't have infinities, then T1 is
......
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