[PATCH lib/Test/Builder.pm t/output.t] "Escape" newlines in test output

[chromatic]

I'm not dead or pining for the fjords.

This was discussed at the end of January on p5p, and Benjamin Goldberg
suggested the regexp solution that appears here.

-- c

diff -ur Test-Simple-0.43old/lib/Test/Builder.pm Test-Simple-0.43/lib/Test/Builder.pm
--- Test-Simple-0.43old/lib/Test/Builder.pm     Thu Apr 11 19:56:09 2002
+++ Test-Simple-0.43/lib/Test/Builder.pm        Sat Apr 13 16:15:21 2002
@@ -842,7 +842,7 @@
 =cut
 
 sub _print {
-    my($self, @msgs) = @_;
+    my $self = shift;
 
     # Prevent printing headers when only compiling.  Mostly for when
     # tests are deparsed with B::Deparse
@@ -850,7 +850,14 @@
 
     local($\, $", $,) = (undef, ' ', '');
     my $fh = $self->output;
-    print $fh @msgs;
+
+    # Ensure that the hash character precedes all newlines in output
+    # (so as not to confuse poor Test::Harness)
+    foreach my $msg (@_) {
+        $msg =~ s/\n(?:\z|$)//g;
+        $msg =~ s/\n[ \t]*#?[ \t]*/\n# /g;
+        print $fh $msg, "\n";
+    }
 }
 
 
diff -ur Test-Simple-0.43old/t/output.t Test-Simple-0.43/t/output.t
--- Test-Simple-0.43old/t/output.t      Wed Jan 30 16:26:25 2002
+++ Test-Simple-0.43/t/output.t Sat Apr 13 16:14:51 2002
@@ -8,7 +8,7 @@
 }
 
 # Can't use Test.pm, that's a 5.005 thing.
-print "1..3\n";
+print "1..5\n";
 
 my $test_num = 1;
 # Utility testing functions.
@@ -23,6 +23,13 @@
     $test_num++;
 }
 
+BEGIN {
+    package Test::Builder;
+    use subs qw( exit );
+    package main;
+}
+
+use vars qw( $TODO );
 use Test::Builder;
 my $Test = Test::Builder->new();
 
@@ -55,3 +62,43 @@
 ok($lines[1] =~ /Hello!/);
 
 unlink('foo');
+
+local *FAKEOUT;
+$out = tie *FAKEOUT, 'TieOut';
+$Test->output(\*FAKEOUT);
+{
+    $TODO = '';
+
+    local *Test::Builder::exit;
+    *Test::Builder::exit = sub (;$) {};
+    $Test->exported_to('main');
+    $Test->no_ending(1);
+    $Test->no_plan();
+
+    # create output, add extraneous newlines
+    $Test->skip_all("skip all\n");
+    $Test->ok(1, "ok\n");
+    $Test->skip("skip\n");
+    $Test->todo_skip("todo\nskip\n");
+}
+
+# each test should have only one newline, so as not to confuse Test::Harness
+@lines = split(/\n/, $out->read());
+ok( @lines == 5, '... should separate tests with newlines' );
+ok( $lines[-1] eq "# skip", '... and should escape newlines in test names' );
+
+package TieOut;
+
+sub TIEHANDLE {
+    bless( \(my $scalar), $_[0]);
+}
+
+sub PRINT {
+    my $self = shift;
+    $$self .= join('', @_);
+}
+
+sub read {
+    my $self = shift;
+    return substr($$self, 0, length($$self), '');
+}