| Subject: | [PATCH] segment tester dispatch() |
Hi,
I've come across 2 bugs in Pipeline::Segment::Tester:
(1) $pt->dispatch( $seg, ... ) doesn't set $seg->store or $seg->parent
(2) $pt->dispatch( ..., $stored_item ) keeps $stored_item around in all new Tester segments. And probably other segments, for that matter. This is because $pt->pipe->cleanup never gets called so $::TRANSACTION_STORE sticks around when it shouldn't.
The attached patch fixes these problems. It has the side-effect of making the Tester act more like a Pipeline, which I thought was the Right Thing. But it might not be backwards compatible.
-Steve
diff -ruN Pipeline-3.01.orig/lib/Pipeline/Segment/Tester.pm Pipeline-3.01/lib/Pipeline/Segment/Tester.pm
--- Pipeline-3.01.orig/lib/Pipeline/Segment/Tester.pm Thu Apr 3 09:54:14 2003
+++ Pipeline-3.01/lib/Pipeline/Segment/Tester.pm Sat Apr 19 15:24:36 2003
@@ -6,7 +6,7 @@
use Pipeline;
use Pipeline::Base;
use base qw(Pipeline::Base);
-our $VERSION = 3.01;
+our $VERSION = 3.011;
sub init {
my $self = shift;
@@ -32,8 +32,11 @@
sub test {
my $self = shift;
my $seg = shift;
+
+ $self->pipe->add_segment($seg);
$self->pipe->store->set($_) foreach @_;
- return $seg->dispatch( $self->pipe );
+
+ return $self->pipe->dispatch();
}
1;
@@ -73,9 +76,11 @@
=item test( Pipeline::Segment, [ ARRAY ] )
-The C<test> method takes a segment object as its first argument, which it will dispatch. It takes
-an infinite number of additional paramaters that will be added to the store prior to dispatch of the
-segment.
+The C<test> method takes a segment object as its first argument, which it will add to its
+pipeline before dispatch. It also takes an infinite number of additional paramaters that
+will be added to the store prior to dispatch of the pipeline.
+
+Returns the production of the pipeline.
=item pipe( [ Pipeline ] )
diff -ruN Pipeline-3.01.orig/t/08tester.t Pipeline-3.01/t/08tester.t
--- Pipeline-3.01.orig/t/08tester.t Thu Jan 1 01:00:00 1970
+++ Pipeline-3.01/t/08tester.t Sat Apr 19 15:25:46 2003
@@ -0,0 +1,38 @@
+use lib './lib';
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use Pipeline::Segment::Tester;
+
+my $pt = Pipeline::Segment::Tester->new();
+my $seg = Test::Segment->new();
+my $obj = bless( { test => 1 }, 'Test' );
+my $prod = $pt->test( $seg, $obj );
+
+is( $pt->pipe->store->get('Test'), $obj, 'obj still in store' );
+
+my $pt2 = Pipeline::Segment::Tester->new();
+is( $pt2->pipe->store->get('Test'), undef, 'store reset' );
+
+
+package Test::Segment;
+
+use Test::More;
+
+use base qw( Pipeline::Segment );
+
+sub dispatch {
+ my $self = shift;
+ my $pipe = shift;
+
+ ok( $pipe, 'dispatch( $pipe )' );
+
+ ok( $self->parent, '$self->parent set on dispatch' );
+ ok( $self->store, '$self->store set on dispatch' );
+
+ return;
+}
+