OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision nested in a disabled pragma. 

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.

From-SVN: r177347
This commit is contained in:
Thomas Quinot 2011-08-04 09:48:09 +00:00 committed by Arnaud Charlet
parent 4641426688
commit c2873f7423
7 changed files with 108 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
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

86
gcc/ada/par_sco.adb
View File

@ -113,11 +113,12 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-- 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
@ -462,6 +466,11 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
---------------------
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 @@ package body Par_SCO is
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;
-----------------------------------------

5
gcc/ada/par_sco.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -57,6 +57,9 @@ package Par_SCO is
-- 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,

11
gcc/ada/put_scos.adb
View File

@ -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 @@ begin
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;

15
gcc/ada/scos.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -30,14 +30,15 @@ package body SCOs is
-------------
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;
----------------

15
gcc/ada/scos.ads
View File

@ -353,6 +353,10 @@ package SCOs is
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 @@ package SCOs is
-- 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;

6
gcc/ada/sem_prag.adb
View File

@ -1700,7 +1700,7 @@ package body Sem_Prag is
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
@ -6713,11 +6713,11 @@ package body Sem_Prag is
-- 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);