This is 1.10

[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Parser / XML / Twig.pm

diff --git a/lib/Test/Valgrind/Parser/XML/Twig.pm b/lib/Test/Valgrind/Parser/XML/Twig.pm
index b3568c89a6c9a8ae98e045b7f05d13aa007a46c8..bc0df39dccff942e4d3730ecb6d121149ba47822 100644 (file)
--- a/lib/Test/Valgrind/Parser/XML/Twig.pm
+++ b/lib/Test/Valgrind/Parser/XML/Twig.pm
@@ -3,16 +3,17 @@ package Test::Valgrind::Parser::XML::Twig;
 use strict;
 use warnings;
 
-our $VERSION = '1.02';
+our $VERSION = '1.10';
 
 use Scalar::Util ();
 
-use base qw/XML::Twig Test::Valgrind::Carp/;
+use base qw/Test::Valgrind::Parser::XML Test::Valgrind::Carp XML::Twig/;
 
 BEGIN { XML::Twig->add_options('Stash'); }
 
 my %handlers = (
- '/valgrindoutput/error' => \&handle_error,
+ '/valgrindoutput/protocolversion' => \&handle_version,
+ '/valgrindoutput/error'           => \&handle_error,
 );
 
 sub new {
@@ -32,11 +33,12 @@ sub new {
 
 sub stash { shift->{Stash} }
 
+eval "sub $_ { \@_ <= 1 ? \$_[0]->{$_} : (\$_[0]->{$_} = \$_[1]) }"
+                                              for qw/_session protocol_version/;
+
 # We must store the session in ourselves because it's only possible to pass
 # arguments to XML::Twig objects by a global stash.
 
-sub _session { @_ <= 1 ? $_[0]->{_session} : ($_[0]->{_session} = $_[1]) }
-
 sub start {
  my ($self, $sess) = @_;
 
@@ -64,6 +66,14 @@ sub finish {
  return;
 }
 
+sub handle_version {
+ my ($twig, $node) = @_;
+
+ $twig->protocol_version($node->text);
+
+ $twig->purge;
+}
+
 sub handle_error {
  my ($twig, $node) = @_;
 
@@ -72,12 +82,19 @@ sub handle_error {
 
  my $data;
 
- $data->{what}  = $node->kid('what')->text;
+ my ($what, $xwhat);
+ if ($twig->protocol_version >= 4) {
+  $xwhat = $node->first_child('xwhat');
+  $what  = $xwhat->kid('text')->text if defined $xwhat;
+ }
+ $what = $node->kid('what')->text unless defined $what;
+ $data->{what} = $what;
+
  $data->{stack} = [ map $_->listify_frame,
                                        $node->kid('stack')->children('frame') ];
 
  for (qw/leakedbytes leakedblocks/) {
-  my $kid = $node->first_child($_);
+  my $kid = ($xwhat || $node)->first_child($_);
   next unless $kid;
   $data->{$_} = int $kid->text;
  }
@@ -110,7 +127,7 @@ sub handle_error {
 
 package Test::Valgrind::Parser::XML::Twig::Elt;
 
-our $VERSION = '1.02';
+our $VERSION = '1.10';
 
 BEGIN { require XML::Twig; }