]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/commitdiff
Move the rest of the XML parser from Tool::memcheck to Parser::XML::Twig
authorVincent Pit <vince@profvince.com>
Sat, 19 Sep 2009 22:06:01 +0000 (00:06 +0200)
committerVincent Pit <vince@profvince.com>
Sat, 19 Sep 2009 22:06:01 +0000 (00:06 +0200)
lib/Test/Valgrind/Parser/XML/Twig.pm
lib/Test/Valgrind/Tool/memcheck.pm

index a949e81b4856ff9b51513f845c5f4bc9f624e4be..b3568c89a6c9a8ae98e045b7f05d13aa007a46c8 100644 (file)
@@ -22,11 +22,6 @@ sub new {
  my %args = @_;
  my $stash = delete $args{stash} || { };
 
- my $tool = delete $args{tool};
- $class->_croak('Invalid tool') unless Scalar::Util::blessed($tool)
-                                         and $tool->isa('Test::Valgrind::Tool');
- $stash->{tool} = $tool;
-
  bless $class->XML::Twig::new(
   elt_class     => __PACKAGE__ . '::Elt',
   stash         => $stash,
@@ -37,6 +32,38 @@ sub new {
 
 sub stash { shift->{Stash} }
 
+# 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) = @_;
+
+ $self->SUPER::start($sess);
+ $self->_session($sess);
+
+ return;
+}
+
+sub parse {
+ my ($self, $sess, $fh) = @_;
+
+ $self->XML::Twig::parse($fh);
+ $self->purge;
+
+ return;
+}
+
+sub finish {
+ my ($self, $sess) = @_;
+
+ $self->_session(undef);
+ $self->SUPER::finish($sess);
+
+ return;
+}
+
 sub handle_error {
  my ($twig, $node) = @_;
 
@@ -68,10 +95,9 @@ sub handle_error {
                                      $origin->kid('stack')->children('frame') ];
  }
 
- my $tool = $twig->stash->{tool};
- my $sess = $tool->_session;
+ my $sess = $twig->_session;
 
- $sess->report($tool->report_class($sess)->new(
+ $sess->report($sess->report_class($sess)->new(
   kind => $kind,
   id   => $id,
   data => $data,
index 87852cf5bed7757d23e8661cad90288f10462bc1..e75f0c0dd0dda9492d35666052f1d588dbd952f5 100644 (file)
@@ -58,8 +58,6 @@ sub new {
 
  $self->{callers} = $callers;
 
- $self->{twig} = Test::Valgrind::Tool::memcheck::Twig->new(tool => $self);
-
  $self;
 }
 
@@ -73,14 +71,6 @@ Read-only accessor for the C<callers> option.
 
 sub callers { $_[0]->{callers} }
 
-=head2 C<twig>
-
-Read-only accessor for the underlying L<XML::Twig> parser.
-
-=cut
-
-sub twig { $_[0]->{twig} }
-
 sub suppressions_tag { 'memcheck-' . $_[1]->version }
 
 =head2 C<report_class_analysis $session>
@@ -114,39 +104,6 @@ sub args {
  return @args;
 }
 
-# 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) = @_;
-
- $self->SUPER::start($sess);
- $self->_session($sess);
-
- return;
-}
-
-sub parse_analysis {
- my ($self, $sess, $fh) = @_;
-
- my $twig = $self->twig;
- $twig->parse($fh);
- $twig->purge;
-
- return;
-}
-
-sub finish {
- my ($self, $sess) = @_;
-
- $self->_session(undef);
- $self->SUPER::finish($sess);
-
- return;
-}
-
 =head1 SEE ALSO
 
 L<Test::Valgrind>, L<Test::Valgrind::Tool>.