===================================================================
@@ -113,11 +113,12 @@
-- 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);
@@ -329,8 +330,11 @@
-- Version taking a node
+ 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
@@ -462,6 +466,11 @@
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
@@ -475,11 +484,12 @@
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
@@ -491,7 +501,6 @@
SCO_Table.Table (SCO_Table.Last).C2 := 'd';
Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
end if;
-
end Output_Header;
------------------------------
@@ -623,6 +632,12 @@
end if;
Traverse (N);
+
+ -- Reset Pragma_Sloc after full subtree traversal
+
+ if T = 'P' then
+ Pragma_Sloc := No_Location;
+ end if;
end Process_Decisions;
-----------
@@ -733,6 +748,31 @@
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 --
----------------
@@ -863,11 +903,12 @@
---------------------
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
@@ -891,11 +932,12 @@
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;
-----------------------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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- --
@@ -57,6 +57,9 @@
-- 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,
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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- --
@@ -30,14 +30,15 @@
-------------
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;
----------------
===================================================================
@@ -353,6 +353,10 @@
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 (
@@ -477,11 +481,12 @@
-- 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;
===================================================================
@@ -23,7 +23,8 @@
-- --
------------------------------------------------------------------------------
-with SCOs; use SCOs;
+with Par_SCO; use Par_SCO;
+with SCOs; use SCOs;
procedure Put_SCOs is
Ctr : Nat;
@@ -145,9 +146,13 @@
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;
The decision SCO for the boolean expression in a pragma Assert is emitted only if assertion checking is enabled. This change ensures that this also applies to any nested decision within that expression. The following compilation must produce two decision SCOs (a CP and a CX) when compiled with -gnata, and none without: $ gcc -c -gnateS -gnata decision_in_assert.adb $ grep "^C[PX]" decision_in_assert.ali CP 6:4 c6:19-6:34 CX &6:25 c6:23-6:23 c6:34-6:34 $ gcc -c -gnateS decision_in_assert.adb $ grep "^C[PX]" decision_in_assert.ali <no output> procedure Decision_In_Assert (A, B : Boolean) is function Id (X : Boolean) return Boolean is begin return X; end Id; pragma Assert (Id (A and then B)); begin null; end Decision_In_Assert; Tested on x86_64-pc-linux-gnu, committed on trunk 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.