+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.
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
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
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
T : SCO_Table_Entry renames SCO_Table.Table (Start);
Continuation : Boolean;
+ Ctr : Nat;
+ -- Counter for statement entries
+
begin
case T.C1 is
end if;
if Ctr = 0 then
- Write_Info_Initiate ('C');
+ Write_SCO_Initiate (U);
if not Continuation then
Write_Info_Char ('S');
Continuation := True;
-- 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
-- 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
-- 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
-- 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;
-- Duplicate the call. This is required to avoid problems with
-- the tree transformations performed by Try_Object_Operation.
- and then Try_Object_Operation
- (N => Sinfo.Name (New_Copy_Tree (Parent (N))),
- CW_Test_Only => True)
+ and then
+ Try_Object_Operation
+ (N => Sinfo.Name (New_Copy_Tree (Parent (N))),
+ CW_Test_Only => True)
then
return;
end if;
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.
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
- and then Chars (Result) /= Name_uPostconditions;
+ exit when not Ekind_In (Result, E_Block, E_Loop)
+ and then Chars (Result) /= Name_uPostconditions;
end loop;
pragma Assert (Present (Result));
projects / gcc.git / commitdiff