From patchwork Tue Jul 17 09:50:29 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 171366 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 5B1922C0154 for ; Tue, 17 Jul 2012 19:50:50 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1343123451; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=hR4id3CIAFHug608qehB mwiNSFU=; b=kM++gg9ZCFitcnGPYhhrenpT8WtNB1Z2Id34WSlcoSzjGF0Mai+z apEipbe1H6cAo4IBncNBhsimsVU8UBVEtyx656qswYGfl7NqnzxuchepxGNHoKGD nlblultSu/qjPcMyrkgeKREmJ8l7gJ7WgU4R/uOXtPnAZR5JNEwbN30= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=AHMsp/lf13tpOITPK0yiGyyNDPdAHZrIkH6N2mbIn/A8ukTi/Lb//GX9hrlleO hLG84oYWKtN4oZYjxlp8wL75Q9D4OqY+UWSVTrRSdTj2yUX3/Qs4nFQCw7hqK29R qj44DUVKJpDcCUXaArVsz4YEHUbBD0X8p9Y/2YG69pZno=; Received: (qmail 20740 invoked by alias); 17 Jul 2012 09:50:47 -0000 Received: (qmail 20731 invoked by uid 22791); 17 Jul 2012 09:50:46 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 17 Jul 2012 09:50:31 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0257E1C70F0; Tue, 17 Jul 2012 05:50:30 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id COsMOBAe4szz; Tue, 17 Jul 2012 05:50:29 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id CD3B11C6FCF; Tue, 17 Jul 2012 05:50:29 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id C5DF83FF09; Tue, 17 Jul 2012 05:50:29 -0400 (EDT) Date: Tue, 17 Jul 2012 05:50:29 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Tristan Gingold Subject: [Ada] Add new debug procedure psloc Message-ID: <20120717095029.GA7820@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Add a new debug procedure psloc, to display a source location. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-17 Tristan Gingold * treepr.ads (psloc): Declare. * treepr.adb (psloc): New debug procedure to print a sloc. (Print_Sloc): New procedure, from ... (Print_Node_Subtree): ... this. Call Print_Sloc. Index: treepr.adb =================================================================== --- treepr.adb (revision 189565) +++ treepr.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -188,6 +188,9 @@ -- level and the bars used to link list elements). In addition, for lines -- other than the first, an additional character Prefix_Char is output. + procedure Print_Sloc (Loc : Source_Ptr); + -- Print the human readable representation of Loc + function Serial_Number (Id : Int) return Nat; -- Given a Node_Id, List_Id or Elist_Id, returns the previously assigned -- serial number, or zero if no serial number has yet been assigned. @@ -887,7 +890,6 @@ Field_To_Be_Printed : Boolean; Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1); - Sfile : Source_File_Index; Fmt : UI_Format; begin @@ -933,20 +935,7 @@ Print_Str (Prefix_Str_Char); Print_Str ("Sloc = "); - if Sloc (N) = Standard_Location then - Print_Str ("Standard_Location"); - - elsif Sloc (N) = Standard_ASCII_Location then - Print_Str ("Standard_ASCII_Location"); - - else - Sfile := Get_Source_File_Index (Sloc (N)); - Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First)); - Write_Str (" "); - Write_Location (Sloc (N)); - end if; - - Print_Eol; + Print_Sloc (Sloc (N)); end if; -- Print Chars field if present @@ -1397,6 +1386,30 @@ Print_Term; end Print_Node_Subtree; + ---------------- + -- Print_Sloc -- + ---------------- + + procedure Print_Sloc (Loc : Source_Ptr) is + Sfile : Source_File_Index; + + begin + if Loc = Standard_Location then + Print_Str ("Standard_Location"); + + elsif Loc = Standard_ASCII_Location then + Print_Str ("Standard_ASCII_Location"); + + else + Sfile := Get_Source_File_Index (Loc); + Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First)); + Write_Str (" "); + Write_Location (Loc); + end if; + + Print_Eol; + end Print_Sloc; + --------------- -- Print_Str -- --------------- @@ -1524,6 +1537,16 @@ Print_Node (N, Label, ' '); end Print_Tree_Node; + ----------- + -- psloc -- + ----------- + + procedure psloc (Loc : Source_Ptr) is + begin + Phase := Printing; + Print_Sloc (Loc); + end psloc; + -------- -- pt -- -------- Index: treepr.ads =================================================================== --- treepr.ads (revision 189565) +++ treepr.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -71,6 +71,10 @@ pragma Export (Ada, ppp); -- Same as Print_Node_Subtree + procedure psloc (Loc : Source_Ptr); + pragma Export (Ada, psloc); + -- Prints the sloc Loc + -- The following are no longer needed; you can use pp or ppp instead procedure pe (E : Elist_Id);