+2011-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision
+ nested in a disabled pragma.
+ * scos.ads, scos.adb, par_sco.ads, par_sco.adb: Record sloc of
+ enclosing pragma, if any, for X decisions.
+
+2011-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * sem_prag.adb: Minor reformatting.
+
2011-08-04 Vincent Celier <celier@adacore.com>
* a-tags.adb (Check_TSD): Avoid concatenation of strings, as it is not
-- Calls above procedure for each element of the list L
procedure Set_Table_Entry
- (C1 : Character;
- C2 : Character;
- From : Source_Ptr;
- To : Source_Ptr;
- Last : Boolean);
+ (C1 : Character;
+ C2 : Character;
+ From : Source_Ptr;
+ To : Source_Ptr;
+ Last : Boolean;
+ Pragma_Sloc : Source_Ptr := No_Location);
-- Append an entry to SCO_Table with fields set as per arguments
procedure Traverse_Declarations_Or_Statements (L : List_Id);
-- Version taking a node
- procedure Process_Decisions (N : Node_Id; T : Character) is
+ Pragma_Sloc : Source_Ptr := No_Location;
+ -- While processing decisions within a pragma Assert/Debug/PPC, this is set
+ -- to the sloc of the pragma.
+ procedure Process_Decisions (N : Node_Id; T : Character) is
Mark : Nat;
-- This is used to mark the location of a decision sequence in the SCO
-- table. We use it for backing out a simple decision in an expression
Loc := Sloc (Parent (Parent (N)));
+ -- Record sloc of pragma (pragmas don't nest)
+
+ pragma Assert (Pragma_Sloc = No_Location);
+ Pragma_Sloc := Loc;
+
when 'X' =>
-- For an expression, no Sloc
end case;
Set_Table_Entry
- (C1 => T,
- C2 => ' ',
- From => Loc,
- To => No_Location,
- Last => False);
+ (C1 => T,
+ C2 => ' ',
+ From => Loc,
+ To => No_Location,
+ Last => False,
+ Pragma_Sloc => Pragma_Sloc);
if T = 'P' then
SCO_Table.Table (SCO_Table.Last).C2 := 'd';
Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
end if;
-
end Output_Header;
------------------------------
end if;
Traverse (N);
+
+ -- Reset Pragma_Sloc after full subtree traversal
+
+ if T = 'P' then
+ Pragma_Sloc := No_Location;
+ end if;
end Process_Decisions;
-----------
Write_SCOs_To_ALI_File;
end SCO_Output;
+ -------------------------
+ -- SCO_Pragma_Disabled --
+ -------------------------
+
+ function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is
+ Index : Nat;
+
+ begin
+ if Loc = No_Location then
+ return False;
+ end if;
+
+ Index := Condition_Pragma_Hash_Table.Get (Loc);
+
+ -- The test here for zero is to deal with possible previous errors
+
+ if Index /= 0 then
+ pragma Assert (SCO_Table.Table (Index).C1 = 'P');
+ return SCO_Table.Table (Index).C2 = 'd';
+
+ else
+ return False;
+ end if;
+ end SCO_Pragma_Disabled;
+
----------------
-- SCO_Record --
----------------
---------------------
procedure Set_Table_Entry
- (C1 : Character;
- C2 : Character;
- From : Source_Ptr;
- To : Source_Ptr;
- Last : Boolean)
+ (C1 : Character;
+ C2 : Character;
+ From : Source_Ptr;
+ To : Source_Ptr;
+ Last : Boolean;
+ Pragma_Sloc : Source_Ptr := No_Location)
is
function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format
begin
Add_SCO
- (C1 => C1,
- C2 => C2,
- From => To_Source_Location (From),
- To => To_Source_Location (To),
- Last => Last);
+ (C1 => C1,
+ C2 => C2,
+ From => To_Source_Location (From),
+ To => To_Source_Location (To),
+ Last => Last,
+ Pragma_Sloc => Pragma_Sloc);
end Set_Table_Entry;
-----------------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- analysis is on a copy of the node, which is different from the node
-- seen by Par_SCO in the parse tree (but the Sloc values are the same).
+ function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean;
+ -- True if Loc is the source location of a disabled pragma
+
procedure SCO_Output;
-- Outputs SCO lines for all units, with appropriate section headers, for
-- unit U in the ALI file, as recorded by previous calls to SCO_Record,
-- --
------------------------------------------------------------------------------
-with SCOs; use SCOs;
+with Par_SCO; use Par_SCO;
+with SCOs; use SCOs;
procedure Put_SCOs is
Ctr : Nat;
when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' =>
Start := Start + 1;
- -- For disabled pragma, skip decision output
+ -- For disabled pragma, or nested decision nested, skip
+ -- decision output.
- if T.C1 = 'P' and then T.C2 = 'd' then
+ if (T.C1 = 'P' and then T.C2 = 'd')
+ or else
+ SCO_Pragma_Disabled (T.Pragma_Sloc)
+ then
while not SCO_Table.Table (Start).Last loop
Start := Start + 1;
end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-------------
procedure Add_SCO
- (From : Source_Location := No_Source_Location;
- To : Source_Location := No_Source_Location;
- C1 : Character := ' ';
- C2 : Character := ' ';
- Last : Boolean := False)
+ (From : Source_Location := No_Source_Location;
+ To : Source_Location := No_Source_Location;
+ C1 : Character := ' ';
+ C2 : Character := ' ';
+ Last : Boolean := False;
+ Pragma_Sloc : Source_Ptr := No_Location)
is
begin
- SCO_Table.Append ((From, To, C1, C2, Last));
+ SCO_Table.Append ((From, To, C1, C2, Last, Pragma_Sloc));
end Add_SCO;
----------------
C1 : Character;
C2 : Character;
Last : Boolean;
+
+ Pragma_Sloc : Source_Ptr := No_Location;
+ -- For a SCO nested with a pragma Debug/Assert/PPC, location of pragma
+ -- (used for control of SCO output, value not recorded in ALI file).
end record;
package SCO_Table is new GNAT.Table (
-- Reset tables for a new compilation
procedure Add_SCO
- (From : Source_Location := No_Source_Location;
- To : Source_Location := No_Source_Location;
- C1 : Character := ' ';
- C2 : Character := ' ';
- Last : Boolean := False);
+ (From : Source_Location := No_Source_Location;
+ To : Source_Location := No_Source_Location;
+ C1 : Character := ' ';
+ C2 : Character := ' ';
+ Last : Boolean := False;
+ Pragma_Sloc : Source_Ptr := No_Location);
-- Adds one entry to SCO table with given field values
end SCOs;
return;
end Chain_PPC;
- -- Start of processing for Check_Precondition_Postcondition
+ -- Start of processing for Check_Precondition_Postcondition
begin
if not Is_List_Member (N) then
-- cause insertion of actions that would escape the attempt to
-- suppress the check code.
- -- Note that the Sloc for the if statement corresponds to the
+ -- Note that the Sloc for the IF statement corresponds to the
-- argument condition, not the pragma itself. The reason for this
-- is that we may generate a warning if the condition is False at
-- compile time, and we do not want to delete this warning when we
- -- delete the if statement.
+ -- delete the IF statement.
Expr := Get_Pragma_Arg (Arg2);
projects / gcc.git / commitdiff