aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sprint.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-07-30 15:53:11 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2014-07-30 15:53:11 +0200
commitd3e16619ae38fba5a464064046114a6638d1816f (patch)
treef34b8a064f087cdef85b843e241141f43015292c /gcc/ada/sprint.adb
parentfccaf220f3c01660f800b6ea055463823051904c (diff)
downloadgcc-d3e16619ae38fba5a464064046114a6638d1816f.zip
gcc-d3e16619ae38fba5a464064046114a6638d1816f.tar.gz
gcc-d3e16619ae38fba5a464064046114a6638d1816f.tar.bz2
[multiple changes]
2014-07-30 Vincent Celier <celier@adacore.com> * debug.adb: Minor comment update. 2014-07-30 Robert Dewar <dewar@adacore.com> * s-tasuti.adb, s-tassta.adb: Minor reformatting. * sprint.adb (Sprint_Node): Handle N_Contract case. * exp_prag.adb: Minor reformatting. * freeze.adb (Freeze_Entity): Check useless postcondition for No_Return subprogram. * sem_prag.adb: Minor reformatting. 2014-07-30 Javier Miranda <miranda@adacore.com> * a-tags.ads: Complete comments about performance. 2014-07-30 Fedor Rybin <frybin@adacore.com> * gnat_ugn.texi: Adding description for --exit-status option to gnattest section. Fixing index entry of --passed-tests option in gnattest section. 2014-07-30 Javier Miranda <miranda@adacore.com> * Makefile.rtl, gnat_rm.texi, i-cpp.adb, i-cpp.ads, impunit.adb, rtsfind.ads: Remove references to package Interfaces.CPP since this package is no longer needed. From-SVN: r213270
Diffstat (limited to 'gcc/ada/sprint.adb')
-rw-r--r--gcc/ada/sprint.adb88
1 files changed, 85 insertions, 3 deletions
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 55669c7..3eb4869 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -58,6 +58,10 @@ package body Sprint is
-- requiring Sloc fixup, until Set_Debug_Sloc is called to set the proper
-- value. The call clears it back to Empty.
+ First_Debug_Sloc : Source_Ptr;
+ -- Sloc of first byte of the current output file if we are generating a
+ -- source debug file.
+
Debug_Sloc : Source_Ptr;
-- Sloc of first byte of line currently being written if we are
-- generating a source debug file.
@@ -512,7 +516,38 @@ package body Sprint is
procedure Set_Debug_Sloc is
begin
if Debug_Generated_Code and then Present (Dump_Node) then
- Set_Sloc (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
+ declare
+ Loc : constant Source_Ptr := Sloc (Dump_Node);
+
+ begin
+ -- Do not change the location of nodes defined in package Standard
+ -- and nodes of pragmas scanned by Targparm.
+
+ if Loc <= Standard_Location then
+ null;
+
+ -- Update the location of a node which is part of the current .dg
+ -- output. This situation occurs in comma separated parameter
+ -- declarations since each parameter references the same parameter
+ -- type node (ie. obj1, obj2 : <param-type>).
+
+ -- Note: This case is needed here since we cannot use the routine
+ -- In_Extended_Main_Code_Unit with nodes whose location is a .dg
+ -- file.
+
+ elsif Loc >= First_Debug_Sloc then
+ Set_Sloc (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
+
+ -- Do not change the location of nodes which are not part of the
+ -- generated code
+
+ elsif not In_Extended_Main_Code_Unit (Loc) then
+ null;
+
+ else
+ Set_Sloc (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
+ end if;
+ end;
-- We do not know the actual end location in the generated code and
-- it could be much closer than in the source code, so play safe.
@@ -581,6 +616,7 @@ package body Sprint is
Debug_Flag_G := False;
Debug_Flag_O := False;
Debug_Flag_S := False;
+ First_Debug_Sloc := No_Location;
-- Dump requested units
@@ -598,6 +634,7 @@ package body Sprint is
if Debug_Generated_Code then
Set_Special_Output (Print_Debug_Line'Access);
Create_Debug_Source (Source_Index (U), Debug_Sloc);
+ First_Debug_Sloc := Debug_Sloc;
Write_Source_Line (1);
Last_Line_Printed := 1;
Sprint_Node (Cunit (U));
@@ -1358,10 +1395,55 @@ package body Sprint is
Sprint_Node (Component_Definition (Node));
-- A contract node should not appear in the tree. It is a semantic
- -- node attached to entry and [generic] subprogram entities.
+ -- node attached to entry and [generic] subprogram entities. But we
+ -- still provide meaningful output, in case called from the debugger.
when N_Contract =>
- raise Program_Error;
+ declare
+ P : Node_Id;
+
+ begin
+ Indent_Begin;
+ Write_Str ("N_Contract node");
+ Write_Eol;
+
+ Write_Indent_Str ("Pre_Post_Conditions");
+ Indent_Begin;
+
+ P := Pre_Post_Conditions (Node);
+ while Present (P) loop
+ Sprint_Node (P);
+ P := Next_Pragma (P);
+ end loop;
+
+ Write_Eol;
+ Indent_End;
+
+ Write_Indent_Str ("Contract_Test_Cases");
+ Indent_Begin;
+
+ P := Contract_Test_Cases (Node);
+ while Present (P) loop
+ Sprint_Node (P);
+ P := Next_Pragma (P);
+ end loop;
+
+ Write_Eol;
+ Indent_End;
+
+ Write_Indent_Str ("Classifications");
+ Indent_Begin;
+
+ P := Classifications (Node);
+ while Present (P) loop
+ Sprint_Node (P);
+ P := Next_Pragma (P);
+ end loop;
+
+ Write_Eol;
+ Indent_End;
+ Indent_End;
+ end;
when N_Decimal_Fixed_Point_Definition =>
Write_Str_With_Col_Check_Sloc (" delta ");