diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-07-30 15:53:11 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-07-30 15:53:11 +0200 |
commit | d3e16619ae38fba5a464064046114a6638d1816f (patch) | |
tree | f34b8a064f087cdef85b843e241141f43015292c /gcc/ada/sprint.adb | |
parent | fccaf220f3c01660f800b6ea055463823051904c (diff) | |
download | gcc-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.adb | 88 |
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 "); |