[tapx-dev] [commit][186] ** make stdout catchable **

[ewilhelm at hexten.net]

Revision: 186
Author:   ewilhelm
Date:     2007-07-16 09:03:32 +0100 (Mon, 16 Jul 2007)

Log Message:
-----------
** make stdout catchable **

(though I think we would rather have a filehandle interface)
t/120-harness.t    - update
lib/TAP/Harness.pm - added stdout() property

Modified Paths:
--------------
    trunk/lib/TAP/Harness.pm
    trunk/t/120-harness.t

Modified: trunk/lib/TAP/Harness.pm
===================================================================
--- trunk/lib/TAP/Harness.pm	2007-07-16 06:51:26 UTC (rev 185)
+++ trunk/lib/TAP/Harness.pm	2007-07-16 08:03:32 UTC (rev 186)
@@ -102,6 +102,12 @@
         exec         => sub { shift; shift },
         merge        => sub { shift; shift },
         formatter    => sub { shift; shift },
+        stdout       => sub {
+            my ( $self, $ref ) = @_;
+            ((ref($ref) || '') eq 'SCALAR') or
+                die "catch_output needs a scalar reference";
+            return($ref);
+        },
     );
     my @getter_setters = qw/
       _curr_parser
@@ -250,6 +256,11 @@
 If set to a true value, only test results with directives will be displayed.
 This overrides other settings such as C<verbose> or C<failures>.
 
+=item * C<stdout>
+
+A scalar reference (experimental) for catching standard output.  Maybe
+should be a filehandle.
+
 =back
 
 =cut
@@ -530,7 +541,12 @@
 
 sub output {
     my $self = shift;
-    print @_;
+    if(my $out = $self->stdout) {
+        $$out .= $_ for(@_); # XXX what's $\ here?
+    }
+    else {
+        print @_;
+    }
 }
 
 ##############################################################################

Modified: trunk/t/120-harness.t
===================================================================
--- trunk/t/120-harness.t	2007-07-16 06:51:26 UTC (rev 185)
+++ trunk/t/120-harness.t	2007-07-16 08:03:32 UTC (rev 186)
@@ -305,27 +305,19 @@
         skip "no '$ls'", 1;
     }
 
-    my @output;
-    local $^W;
-    local *TAP::Harness::_should_show_count = sub {0};
-    local *TAP::Harness::output = sub {
-        my $self = shift;
-        push @output => grep { $_ ne '' }
-          map {
-            local $_ = $_;
-            chomp;
-            trim($_)
-          } @_;
-    };
+    my $output = '';
     my $harness = TAP::Harness->new(
         {   verbose => 1,
+            really_quiet => 1,
+            really_quiet => 1,
+            stdout       => \$output,
             exec    => [$ls],
         }
     );
 
     eval { $harness->runtests( 't/execls' ) };
 
-    chomp(@output);
+    my @output = split(/\n/, $output);
     pop @output;                              # get rid of summary line
     my $answer = pop @output;
     is( $answer, 'All tests successful.', 'ls speaks tap' );
@@ -333,21 +325,12 @@
 
 # catches "exec accumulates arguments" issue (r77)
 {
-    my @output;
-    local $^W;
-    local *TAP::Harness::_should_show_count = sub {0};
-    local *TAP::Harness::output = sub {
-        my $self = shift;
-        push @output => grep { $_ ne '' }
-          map {
-            local $_ = $_;
-            chomp;
-            trim($_)
-          } @_;
-    };
+    my $output = '';
     my $harness = TAP::Harness->new(
-        {   verbose => 1,
-            exec    => [$^X]
+        {   verbose      => 1,
+            really_quiet => 1,
+            stdout       => \$output,
+            exec         => [$^X]
         }
     );
 
@@ -356,7 +339,7 @@
         't/source_tests/harness',
     );
 
-    chomp(@output);
+    my @output = split(/\n/, $output);
     pop @output;                              # get rid of summary line
     is( $output[-1], 'All tests successful.', 'No exec accumulation' );
 }