Subtests and todos

lib/Test/Stream/Event/Subtest.pm

@@ -43,6 +43,29 @@ sub init {
     push @{$self->[DIAG]} => "  No tests run for subtest."
         unless $self->[EXCEPTION] || $self->[EARLY_RETURN] || $self->[STATE]->[STATE_COUNT];
 
+    # I HAVE NO IDEA WHAT I'M DOING !!!
+    # The state of the aggregate is computed as follow:
+    # 1. If there is any real error => the aggregate is not ok. Full stop.
+    # 2. If not, if there is any TODO subtests, the aggregate is also TODO
+    # 3. If a TODO is failing, the aggregate result is not ok.
+
+    if ( $self->real_bool ) {
+        # [8][4] == list of events. There's probably a less savage way
+        # of getting them
+        for my $event ( @{ $self->[8][4] || [] } ) {
+            # only bother if it's an OK event and it's in a todo state
+            next unless ( ref $event eq 'Test::Stream::Event::Ok' 
+                          or ref $event eq 'Test::Stream::Event::Subtest' )
+                        and $event->context->in_todo;
+
+            # force the parent test to be in a TODO state
+            $self->context->[3] ||= 1; # force to be TODO
+
+            # if a child fail, so is the parent
+            $self->set_real_bool( 0 ) if not $event->real_bool ;
+        }
+    }
+
     # Have the 'OK' init run
     $self->SUPER::init();
 }

subtest_checks.pl

@@ -0,0 +1,69 @@
+#!/usr/bin/perl 
+
+use strict;
+use warnings;
+
+use Test::More;
+
+subtest passing => sub {
+    pass;
+};
+
+subtest failing => sub {
+    fail;
+};
+
+subtest 'todo okay' => sub {
+    local $TODO = 'normal todo';
+    fail;
+};
+
+subtest 'todo flagged as passing' => sub {
+    local $TODO = 'normal todo';
+    pass;
+};
+
+subtest 'failing' => sub {
+    fail;
+
+    local $TODO = 'normal todo';
+    pass;
+};
+
+subtest 'todo flagged as passing' => sub {
+    pass;
+
+    local $TODO = 'normal todo';
+    pass;
+};
+
+subtest 'todo ok' => sub {
+    pass;
+
+    local $TODO = 'normal todo';
+    fail;
+};
+
+subtest 'embedded top is okay' => sub {
+    subtest 'level 1' => sub {
+        local $TODO = 'normal todo';
+        fail;
+    };
+};
+
+subtest 'embedded top is flagged' => sub {
+    subtest 'level 1' => sub {
+        local $TODO = 'normal todo';
+        pass;
+    };
+};
+
+subtest 'embedded top is flagged' => sub {
+    local $TODO = 'normal todo';
+    subtest 'level 1' => sub {
+        local $TODO = 'normal todo';
+        pass;
+    };
+};
+
+done_testing;