Move TAP logic out of events

lib/Test/Stream/Compare/EventMeta.pm

@@ -5,16 +5,34 @@ use warnings;
 use base 'Test::Stream::Compare::Meta';
 use Test::Stream::HashBase;
 
+use Carp qw/carp/;
+
 sub get_prop_file    { $_[1]->debug->file }
 sub get_prop_line    { $_[1]->debug->line }
 sub get_prop_package { $_[1]->debug->package }
 sub get_prop_subname { $_[1]->debug->subname }
-sub get_prop_skip    { $_[1]->debug->skip }
-sub get_prop_todo    { $_[1]->debug->todo }
 sub get_prop_trace   { $_[1]->debug->trace }
 sub get_prop_tid     { $_[1]->debug->tid }
 sub get_prop_pid     { $_[1]->debug->pid }
 
+sub get_prop_todo {
+    my $self = shift;
+    my ($thing) = @_;
+
+    unless ($thing->can('todo')) {
+        my $type = ref($thing);
+        carp "Use of 'todo' property is deprecated for '$type'";
+        return $thing->debug->_todo;    # deprecated
+    }
+
+    return $thing->todo || $thing->debug->_todo;
+}
+
+sub get_prop_skip {
+    carp "Use of 'skip' property is deprecated";
+    $_[1]->debug->_skip; # Private no-warning version until removed
+}
+
 1;
 
 __END__

lib/Test/Stream/Context.pm

@@ -15,7 +15,7 @@ my %LOADED = (
         require "Test/Stream/Event/$_.pm";
         my $pkg = "Test::Stream::Event::$_";
         ( $pkg => $pkg, $_ => $pkg )
-    } qw/Ok Diag Note Plan Bail Exception Waiting/
+    } qw/Ok Diag Note Plan Bail Exception Waiting Skip/
 );
 
 # Stack is ok to cache.
@@ -195,7 +195,7 @@ sub context {
             frame => [$pkg, $file, $line, $sub],
             pid   => $$,
             tid   => get_tid(),
-            $hub->debug_todo,
+            $hub->_debug_todo,
         },
         'Test::Stream::DebugInfo'
     );
@@ -305,21 +305,29 @@ sub ok {
     my $self = shift;
     my ($pass, $name, $diag) = @_;
 
+    my $hub = $self->{+HUB};
+
     my $e = bless {
         debug => bless( {%{$self->{+DEBUG}}}, 'Test::Stream::DebugInfo'),
         pass  => $pass,
         name  => $name,
+        $hub->_fast_todo,
     }, 'Test::Stream::Event::Ok';
     $e->init;
 
-    return $self->{+HUB}->send($e) if $pass;
+    return $hub->send($e) if $pass;
 
     $diag ||= [];
     unshift @$diag => $e->default_diag;
-
     $e->set_diag($diag);
 
-    $self->{+HUB}->send($e);
+    $hub->send($e);
+}
+
+sub skip {
+    my $self = shift;
+    my ($name, $reason) = @_;
+    $self->send_event('Skip', name => $name, reason => $reason);
 }
 
 sub note {
@@ -331,7 +339,12 @@ sub note {
 sub diag {
     my $self = shift;
     my ($message) = @_;
-    $self->send_event('Diag', message => $message);
+    my $hub = $self->{+HUB};
+    $self->send_event(
+        'Diag',
+        message => $message,
+        todo => $hub->get_todo || $hub->parent_todo,
+    );
 }
 
 sub plan {

lib/Test/Stream/DebugInfo.pm

@@ -4,18 +4,47 @@ use warnings;
 
 use Test::Stream::Util qw/get_tid/;
 
-use Carp qw/confess/;
+use Carp qw/confess carp/;
 
 use Test::Stream::HashBase(
-    accessors => [qw/frame todo skip detail pid tid parent_todo/],
+    accessors => [qw/frame detail pid tid skip todo parent_todo/],
 );
 
+BEGIN {
+    for my $attr (SKIP, TODO, PARENT_TODO) {
+        my $set = __PACKAGE__->can("set_$attr");
+        my $get = __PACKAGE__->can($attr);
+
+        my $new_set = sub {
+            carp "Use of '$attr' attribute for DebugInfo is deprecated";
+            $set->(@_);
+        };
+
+        my $new_get = sub {
+            carp "Use of '$attr' attribute for DebugInfo is deprecated";
+            $get->(@_);
+        };
+
+        no strict 'refs';
+        no warnings 'redefine';
+        *{"set_$attr"}  = $new_set;
+        *{"$attr"}      = $new_get;
+        *{"_$attr"}     = $get;
+        *{"_set_$attr"} = $set;
+    }
+}
+
 sub init {
     confess "Frame is required"
         unless $_[0]->{+FRAME};
 
     $_[0]->{+PID} ||= $$;
     $_[0]->{+TID} ||= get_tid();
+
+    for my $attr (SKIP, TODO, PARENT_TODO) {
+        next unless defined $_[0]->{$attr};
+        $_[0]->alert("Use of '$attr' attribute for DebugInfo is deprecated")
+    }
 }
 
 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
@@ -47,13 +76,25 @@ sub line    { $_[0]->{+FRAME}->[2] }
 sub subname { $_[0]->{+FRAME}->[3] }
 
 sub no_diag {
+    my $self = shift;
+    $self->alert("Use of the 'no_diag' method is deprecated");
+    $self->_no_diag(@_);
+}
+
+sub no_fail {
+    my $self = shift;
+    $self->alert("Use of the 'no_fail' method is deprecated");
+    $self->_no_fail(@_);
+}
+
+sub _no_diag {
     my $self = shift;
     return defined($self->{+TODO})
         || defined($self->{+SKIP})
         || defined($self->{+PARENT_TODO});
 }
 
-sub no_fail {
+sub _no_fail {
     my $self = shift;
     return defined($self->{+TODO})
         || defined($self->{+SKIP});

lib/Test/Stream/Event.pm

@@ -32,11 +32,21 @@ sub init {
 
 sub causes_fail  { 0 }
 
-sub to_tap       {()};
 sub update_state {()};
 sub terminate    {()};
 sub global       {()};
 
+sub to_tap {
+    my $self = shift;
+    my ($num) = @_;
+
+    carp 'Use of $event->to_tap is deprecated';
+
+    require Test::Stream::Formatter::TAP;
+    my $formatter = Test::Stream::Formatter::TAP->new;
+    $formatter->event_tap($self, $num);
+}
+
 1;
 
 __END__
@@ -139,6 +149,9 @@ ensure the event is seen and understood.
 
 =item @output = $e->to_tap($num)
 
+B<***DEPRECATED***> This will be removed in the near future. See
+L<Test::Stream::Formatter::TAP> for TAP production.
+
 This is where you get the chance to produce TAP output. The input argument
 C<$num> will either be the most recent test number, or undefined. The output
 should be a list of arrayrefs, each arrayref should have exactly 2 values:

lib/Test/Stream/Event/Bail.pm

@@ -2,19 +2,9 @@ package Test::Stream::Event::Bail;
 use strict;
 use warnings;
 
-use Test::Stream::Formatter::TAP qw/OUT_STD/;
-
 use base 'Test::Stream::Event';
 use Test::Stream::HashBase accessors => [qw/reason/];
 
-sub to_tap {
-    my $self = shift;
-    return [
-        OUT_STD,
-        "Bail out!  " . $self->reason . "\n",
-    ];
-}
-
 sub update_state {
     my $self = shift;
     my ($state) = @_;

lib/Test/Stream/Event/Diag.pm

@@ -3,11 +3,7 @@ use strict;
 use warnings;
 
 use base 'Test::Stream::Event';
-use Test::Stream::HashBase accessors => [qw/message/];
-
-use Carp qw/confess/;
-
-use Test::Stream::Formatter::TAP qw/OUT_TODO OUT_ERR/;
+use Test::Stream::HashBase accessors => [qw/message todo/];
 
 sub init {
     $_[0]->SUPER::init();
@@ -19,23 +15,6 @@ sub init {
     }
 }
 
-sub to_tap {
-    my $self = shift;
-
-    my $msg = $self->{+MESSAGE};
-    return unless $msg;
-
-    $msg = "# $msg" unless $msg eq "\n";
-
-    chomp($msg);
-    $msg =~ s/\n/\n# /g;
-
-    return [
-        ($self->{+DEBUG}->no_diag ? OUT_TODO : OUT_ERR),
-        "$msg\n",
-    ];
-}
-
 1;
 
 __END__

lib/Test/Stream/Event/Exception.pm

@@ -2,18 +2,9 @@ package Test::Stream::Event::Exception;
 use strict;
 use warnings;
 
-use Test::Stream::Formatter::TAP qw/OUT_ERR/;
-
 use base 'Test::Stream::Event';
 use Test::Stream::HashBase accessors => [qw/error/];
 
-sub to_tap {
-    my $self = shift;
-    return [
-        OUT_ERR, $self->{+ERROR}
-    ];
-}
-
 sub update_state {
     my $self = shift;
     my ($state) = @_;

lib/Test/Stream/Event/Note.pm

@@ -2,8 +2,6 @@ package Test::Stream::Event::Note;
 use strict;
 use warnings;
 
-use Test::Stream::Formatter::TAP qw/OUT_STD/;
-
 use base 'Test::Stream::Event';
 use Test::Stream::HashBase accessors => [qw/message/];
 
@@ -17,17 +15,6 @@ sub init {
     }
 }
 
-sub to_tap {
-    my $self = shift;
-
-    chomp(my $msg = $self->{+MESSAGE});
-    return unless $msg;
-    $msg = "# $msg" unless $msg =~ m/^\n/;
-    $msg =~ s/\n/\n# /g;
-
-    return [OUT_STD, "$msg\n"];
-}
-
 1;
 
 __END__