* Added handling of event handlers using die(), by queuing "die"

  events.
* Issue warning when IO::Multiplex has been subject to die() which
  where not caught and queued. (This is known to happen e.g. when
  hitting die() in Varnish::Test::Server::Connection::mux_eof(), so a
  more complete, long-term die()-wrapping solution is needed.)

git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1847 d4fa192b-c00b-0410-8231-f00ffab90ce4

diff --git a/varnish-tools/regress/lib/Varnish/Test/Engine.pm b/varnish-tools/regress/lib/Varnish/Test/Engine.pm
index b654d95bf2400890274c93a0b6347a234b4330dd..cf453a209916e47853e010f4d0f37c7f34981034 100644 (file)
--- a/varnish-tools/regress/lib/Varnish/Test/Engine.pm
+++ b/varnish-tools/regress/lib/Varnish/Test/Engine.pm
@@ -111,12 +111,22 @@ sub run_loop($@) {
     eval { $self->{'mux'}->loop; };
     delete $self->{'in_loop'};
     delete $self->{'wait_for'};
-    die $@ if ($@);
+    if ($@) {
+       $self->log($self, 'ENG: ', 'IO::Multiplex INCONSISTENT AFTER UNCONTROLLED die().');
+       # Maybe we should just exit() here, since we cannot do much
+       # useful with an inconsistent IO::Multiplex object.
+       die $@;
+    }
 
     # Loop has now been paused due to the occurrence of an event we
-    # were waiting for. This event is always found in the front of the
-    # pending events queue at this point, so return it.
-    return @{shift @{$self->{'pending'}}} if @{$self->{'pending'}} > 0;
+    # were waiting for, or a controlled die(). The event is always
+    # found in the front of the pending events queue at this point, so
+    # return it, or die() if we find a "die event".
+    if (@{$self->{'pending'}} > 0) {
+       my ($event, @args) = @{shift @{$self->{'pending'}}};
+       die $args[0] if ($event eq 'die');
+       return ($event, @args);
+    }
 
     # Hm... we should usually not reach this point. The pending queue
     # is empty. Either someone (erroneously) requested a loop pause by
@@ -153,14 +163,26 @@ sub AUTOLOAD ($;@) {
 
     $self->log($self, 'ENG: ', sprintf('EVENT "%s"', $1));
 
-    # Check to see if the active case object defines an event handler
-    # for this event. If so, call it and bring the event arguments
-    # along. This will also replace @args, which is significant if
-    # this event will pause and return.
-    @args = $self->{'case'}->$event(@args)
-       if (defined($self->{'case'}) and $self->{'case'}->can($event));
-
-    if (@{$self->{'pending'}} > 0) {
+    eval {
+       # Check to see if the active case object defines an event
+       # handler for this event. If so, call it and bring the event
+       # arguments along. This will also replace @args, which is
+       # significant if this event will pause and return.
+       @args = $self->{'case'}->$event(@args)
+           if (defined($self->{'case'}) and $self->{'case'}->can($event));
+    };
+    if ($@) {
+       # The event handler issued die(), which we want to control
+       # because we do not want the IO::Multiplex-loop to be subject
+       # to it. Hence, we queue it as a special event which will be
+       # recognized outside the loop and reissued there, using die().
+       # We put this die-event in the front of the queue, using
+       # "unshift", so we get it through before any other events
+       # already in the queue. Then, signal pause of loop.
+       unshift(@{$self->{'pending'}}, [ 'die', $@ ]);
+       $self->{'mux'}->endloop;
+    }
+    elsif (@{$self->{'pending'}} > 0) {
        # Pending event queue is NOT empty, meaning this is an event
        # arriving after a pausing (wait_for) event, but before the
        # pause is in effect. We queue this event unconditionally