svn commit: r350170 - in head/devel/ahven: . files

[John Marino]

Author: marino
Date: Fri Apr  4 21:35:43 2014
New Revision: 350170
URL: http://svnweb.freebsd.org/changeset/ports/350170
QAT: https://qat.redports.org/buildarchive/r350170/

Log:
  devel/ahven: Improve symbolic traceback functionality
  
  Rather than show the lengthy and not helpful trace of the Ahven
  Framework when a symbolic trace is shown, detect the start of this
  infrastructure trace and truncate it there.  This helps debugging
  greatly by removing a lot of noise.

Modified:
  head/devel/ahven/Makefile
  head/devel/ahven/files/extra-src_ahven-framework.adb

Modified: head/devel/ahven/Makefile
==============================================================================
--- head/devel/ahven/Makefile	Fri Apr  4 21:11:58 2014	(r350169)
+++ head/devel/ahven/Makefile	Fri Apr  4 21:35:43 2014	(r350170)
@@ -3,7 +3,7 @@
 
 PORTNAME=	ahven
 PORTVERSION=	2.4
-PORTREVISION=	3
+PORTREVISION=	4
 CATEGORIES=	devel
 MASTER_SITES=	SF
 MASTER_SITE_SUBDIR=${PORTNAME}/${PORTNAME}/Ahven%20${PORTVERSION}

Modified: head/devel/ahven/files/extra-src_ahven-framework.adb
==============================================================================
--- head/devel/ahven/files/extra-src_ahven-framework.adb	Fri Apr  4 21:11:58 2014	(r350169)
+++ head/devel/ahven/files/extra-src_ahven-framework.adb	Fri Apr  4 21:35:43 2014	(r350170)
@@ -5,30 +5,55 @@
  --
  
 +with GNAT.Traceback.Symbolic;
-+use  GNAT.Traceback.Symbolic;
++with GNAT.Regpat;
  with Ada.Strings;
  with Ada.Unchecked_Deallocation;
  with Ada.Exceptions;
-@@ -346,19 +348,19 @@ package body Ahven.Framework is
+@@ -22,6 +24,24 @@ with Ahven.Long_AStrings;
+ package body Ahven.Framework is
+    use Ahven.AStrings;
+ 
++   -- Convert an exception into a traceback, but truncate it at the first
++   -- line matching "0x.* in ahven.framework" as this is unwanted trace.
++   function Filtered_Traceback (E : in Ada.Exceptions.Exception_Occurrence)
++   return String is
++      ftb : constant String := GNAT.Traceback.Symbolic.Symbolic_Traceback (E);
++      pat : constant String := "(0x[0-9a-f]* in ahven\.framework)";
++      reg : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (pat);
++      result : GNAT.Regpat.Match_Array (0 .. 1);
++      use type GNAT.Regpat.Match_Location;
++   begin
++      GNAT.Regpat.Match (reg, ftb, result);
++      if result (0) = GNAT.Regpat.No_Match then
++         return ftb;
++      else
++         return ftb (1 .. result (1).First - 2);
++      end if;
++   end Filtered_Traceback;
++
+    -- A few local procedures, so we do not need to duplicate code.
+    procedure Free_Test is
+       new Ada.Unchecked_Deallocation (Object => Test'Class,
+@@ -346,19 +366,19 @@ package body Ahven.Framework is
                 Set_Status
                   (S            => TEST_FAIL,
                    Message      => Ada.Exceptions.Exception_Message (E),
 -                  Long_Message => Ada.Exceptions.Exception_Information (E),
-+                  Long_Message => Symbolic_Traceback (E),
++                  Long_Message => Filtered_Traceback (E),
                    R            => Result);
              when E : Test_Skipped_Error =>
                 Set_Status
                   (S            => TEST_SKIP,
                    Message      => Ada.Exceptions.Exception_Message (E),
 -                  Long_Message => Ada.Exceptions.Exception_Information (E),
-+                  Long_Message => Symbolic_Traceback (E),
++                  Long_Message => Filtered_Traceback (E),
                    R            => Result);
              when E : others =>
                 Set_Status
                   (S            => TEST_ERROR,
                    Message      => Ada.Exceptions.Exception_Message (E),
 -                  Long_Message => Ada.Exceptions.Exception_Information (E),
-+                  Long_Message => Symbolic_Traceback (E),
++                  Long_Message => Filtered_Traceback (E),
                    R            => Result);
           end;
        end Run_A_Command;