out of options handler

diff --git a/lib/DX/ResultStream.pm b/lib/DX/ResultStream.pm
index aa54025..28555a9 100644 (file)
--- a/lib/DX/ResultStream.pm
+++ b/lib/DX/ResultStream.pm
@@ -13,12 +13,16 @@ sub next {
   return if $self->is_exhausted;
   my $start_state = do {
     if (my $cur = $self->_current_state) {
-      $cur->backtrack;
+      $cur->push_backtrack;
     } else {
       $self->for_state
     }
   };
   my $state = $self->_current_state($start_state->run);
+  unless ($state) {
+    $self->_set_is_exhausted(1);
+    return;
+  }
   return +{
     map +($_ => $state->scope_var($_)->bound_value), keys %{$state->scope}
   };

diff --git a/lib/DX/State.pm b/lib/DX/State.pm
index 0ee431c..4815ab2 100644 (file)
--- a/lib/DX/State.pm
+++ b/lib/DX/State.pm
@@ -1,5 +1,7 @@
 package DX::State;
 
+use Return::MultiLevel qw(with_return);
+use DX::Op::FromCode;
 use Moo;
 
 has next_op => (is => 'ro', required => 1);
@@ -41,6 +43,9 @@ sub backtrack {
     $var->bound_value; $var->clear_bound_value;
     return $state->mark_choice($var) unless $var->bound_stream->is_exhausted;
   }
+  if (our $No_Options_Handler) {
+    $No_Options_Handler->(undef);
+  }
   die "Out of options";
 }
 
@@ -51,10 +56,18 @@ sub then {
 
 sub run {
   my ($state) = @_;
-  while (my $op = $state->next_op) {
-    $state = $op->run($state);
+  with_return {
+    my ($return) = @_;
+    local our $No_Options_Handler = $return;
+    while (my $op = $state->next_op) {
+      $state = $op->run($state);
+    }
+    return $state;
   }
-  return $state;
+}
+
+sub push_backtrack {
+  $_[0]->then(DX::Op::FromCode->new(code => sub { $_[1]->backtrack }));
 }
 
 1;

diff --git a/t/basic.t b/t/basic.t
index 5539ff4..3bd0684 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -36,36 +36,70 @@ sub bind_array {
   }
 }
 
+sub test_values {
+  my ($vars, $test) = @_;
+  sub {
+    my ($self, $state) = @_;
+    my @values = map $state->scope_var($_)->bound_value, @$vars;
+    if ($test->(@values)) {
+      return $state->then($self->next);
+    }
+    return $state->backtrack;
+  }
+}
+
 my $op = FromCode->new(
   code => bind_array(S => \@servers),
   next => FromCode->new(
-    code => sub {
-      my ($self, $state) = @_;
-      my $server = $state->scope_var('S')->bound_value;
-      if ($server =~ /\.example\.com$/) {
-        return $state->then($self->next);
-      }
-      return $state->backtrack;
-    },
+    code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ })
   )
 );
 
-my %scope = map +($_ => $_), qw(S);
-my %by_id = map +($_ => DX::Var->new(id => $_)), qw(S);
+sub make_state {
+  my ($vars, $op) = @_;
 
-my $state = DX::State->new(
-  next_op => $op,
-  return_stack => [],
-  by_id => \%by_id,
-  scope => \%scope,
-  last_choice => []
-);
+  my %scope = map +($_ => $_), @{$vars};
+  my %by_id = map +($_ => DX::Var->new(id => $_)), @{$vars};
+
+  DX::State->new(
+    next_op => $op,
+    return_stack => [],
+    by_id => \%by_id,
+    scope => \%scope,
+    last_choice => []
+  );
+}
 
-my $stream = DX::ResultStream->new(for_state => $state);
+my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op));
 
 is($stream->next->{'S'}, $_)
   for qw(jim.example.com joe.example.com bob.example.com);
 
-dies_ok { $stream->next } 'No more';
+is($stream->next, undef, 'No more');
+
+exit 0;
+
+my $complex_op = FromCode->new(
+  code => bind_array(S => \@servers),
+  next => FromCode->new(
+    code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
+    next => FromCode->new(
+      code => bind_array(P => \@shells),
+      next => FromCode->new(
+        code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
+      )
+    )
+  )
+);
+
+my $cstream = DX::ResultStream->new(
+  for_state => make_state([ qw(S P) ], $complex_op)
+);
+
+::Dwarn($cstream->next);
+::Dwarn($cstream->next);
+::Dwarn($cstream->next);
+::Dwarn($cstream->next);
+::Dwarn($cstream->next);
 
 done_testing;