Commit 11bc76df by Arnaud Charlet

[multiple changes]

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

	* sem_ch4.adb: Minor reformatting.
	* sem_ch6.adb: Minor code reorganization (use Ekind_In).

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

	* scos.ads: Minor documentation clarification.
	* put_scos.adb: Do not generate SCO unit header line for a unit that
	has no SCO lines.

From-SVN: r178367
parent 876d4394
2011-08-31 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb: Minor reformatting.
* sem_ch6.adb: Minor code reorganization (use Ekind_In).
2011-08-31 Thomas Quinot <quinot@adacore.com>
* scos.ads: Minor documentation clarification.
* put_scos.adb: Do not generate SCO unit header line for a unit that
has no SCO lines.
2011-08-31 Robert Dewar <dewar@adacore.com>
* a-rbtgbo.adb, alfa_test.adb: Minor reformatting.
2011-08-31 Tristan Gingold <gingold@adacore.com>
......
......@@ -28,7 +28,11 @@ with SCOs; use SCOs;
with Snames; use Snames;
procedure Put_SCOs is
Ctr : Nat;
Current_SCO_Unit : SCO_Unit_Index := 0;
-- Initial value must not be a valid unit index
procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
-- Start SCO line for unit SU, also emitting SCO unit header if necessary
procedure Output_Range (T : SCO_Table_Entry);
-- Outputs T.From and T.To in line:col-line:col format
......@@ -72,10 +76,34 @@ procedure Put_SCOs is
end loop;
end Output_String;
------------------------
-- Write_SCO_Initiate --
------------------------
procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
begin
if Current_SCO_Unit /= SU then
Write_Info_Initiate ('C');
Write_Info_Char (' ');
Write_Info_Nat (SUT.Dep_Num);
Write_Info_Char (' ');
Output_String (SUT.File_Name.all);
Write_Info_Terminate;
Current_SCO_Unit := SU;
end if;
Write_Info_Initiate ('C');
end Write_SCO_Initiate;
-- Start of processing for Put_SCOs
begin
-- Loop through entries in SCO_Unit_Table
-- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
-- convention present but unused.
for U in 1 .. SCO_Unit_Table.Last loop
declare
......@@ -88,19 +116,6 @@ begin
Start := SUT.From;
Stop := SUT.To;
-- Write unit header (omitted if no SCOs are generated for this unit)
if Start <= Stop then
Write_Info_Initiate ('C');
Write_Info_Char (' ');
Write_Info_Nat (SUT.Dep_Num);
Write_Info_Char (' ');
Output_String (SUT.File_Name.all);
Write_Info_Terminate;
end if;
-- Loop through SCO entries for this unit
loop
......@@ -111,6 +126,9 @@ begin
T : SCO_Table_Entry renames SCO_Table.Table (Start);
Continuation : Boolean;
Ctr : Nat;
-- Counter for statement entries
begin
case T.C1 is
......@@ -127,7 +145,7 @@ begin
end if;
if Ctr = 0 then
Write_Info_Initiate ('C');
Write_SCO_Initiate (U);
if not Continuation then
Write_Info_Char ('S');
Continuation := True;
......@@ -204,7 +222,7 @@ begin
-- For all other cases output decision line
else
Write_Info_Initiate ('C');
Write_SCO_Initiate (U);
Write_Info_Char (T.C1);
if T.C1 /= 'X' then
......
......@@ -458,8 +458,8 @@ package SCOs is
-- This table keeps track of the units and the corresponding starting and
-- ending indexes (From, To) in the SCO table. Note that entry zero is
-- unused, it is for convenience in calling the sort routine. Thus the
-- real lower bound for active entries is 1.
-- present but unused, it is for convenience in calling the sort routine.
-- Thus the lower bound for real entries is 1.
type SCO_Unit_Index is new Int;
-- Used to index values in this table. Values start at 1 and are assigned
......
......@@ -277,7 +277,8 @@ package body Sem_Ch4 is
-- the call may be overloaded with both interpretations.
function Try_Object_Operation
(N : Node_Id; CW_Test_Only : Boolean := False) return Boolean;
(N : Node_Id;
CW_Test_Only : Boolean := False) return Boolean;
-- Ada 2005 (AI-252): Support the object.operation notation. If node N
-- is a call in this notation, it is transformed into a normal subprogram
-- call where the prefix is a parameter, and True is returned. If node
......@@ -1763,6 +1764,9 @@ package body Sem_Ch4 is
-- Start of processing for Analyze_Explicit_Dereference
begin
-- If source node, check SPARK restriction. We guard this with the
-- source node check, because ???
if Comes_From_Source (N) then
Check_SPARK_Restriction ("explicit dereference is not allowed", N);
end if;
......@@ -4185,7 +4189,8 @@ package body Sem_Ch4 is
-- Duplicate the call. This is required to avoid problems with
-- the tree transformations performed by Try_Object_Operation.
and then Try_Object_Operation
and then
Try_Object_Operation
(N => Sinfo.Name (New_Copy_Tree (Parent (N))),
CW_Test_Only => True)
then
......@@ -4194,6 +4199,7 @@ package body Sem_Ch4 is
end if;
if Etype (N) = Any_Type and then Is_Protected_Type (Prefix_Type) then
-- Case of a prefix of a protected type: selector might denote
-- an invisible private component.
......
......@@ -1355,8 +1355,7 @@ package body Sem_Ch6 is
for J in reverse 0 .. Scope_Stack.Last loop
Result := Scope_Stack.Table (J).Entity;
exit when Ekind (Result) /= E_Block
and then Ekind (Result) /= E_Loop
exit when not Ekind_In (Result, E_Block, E_Loop)
and then Chars (Result) /= Name_uPostconditions;
end loop;
......
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