+ my($tname) = @_;
+
+ $tname = "Main" if !defined $tname;
+ $this->{tree} = $this->_gather_tests($tname)
+ or die "No tests defined";
+ #$this->{tree}->print(0);
+ my $nskipped = 0;
+
+ my @conn = @{ $this->{connections} };
+
+ while (1) {
+ my @copy_conn = @conn; # avoid alias problems after splice()
+ my $nconn = scalar(@copy_conn);
+ foreach my $i0 (0 .. $#copy_conn) {
+ my $conn = $copy_conn[$i0];
+ #print "connection $i0 of $nconn/", scalar(@conn), " is $conn\n";
+ if (!$conn->current_task()) {
+ if (!$conn->next_task()) {
+ # Out of tasks: we need a new test
+ NEXT_TEST:
+ my $address = $conn->option("current_test_address");
+ my $nextaddr;
+ if (!defined $address) {
+ $nextaddr = "";
+ } else {
+ $this->log("irspy_test",
+ "checking for next test after '$address'");
+ $nextaddr = $this->_next_test($address);
+ }
+ if (!defined $nextaddr) {
+ $conn->log("irspy", "has no more tests: removing");
+ splice @conn, $i0, 1;
+ $this->_rewrite_record($conn);
+ next;
+ }
+
+ my $node = $this->{tree}->select($nextaddr)
+ or die "invalid nextaddr '$nextaddr'";
+ $conn->option(current_test_address => $nextaddr);
+ my $tname = $node->name();
+ $conn->log("irspy_test",
+ "starting test '$nextaddr' = $tname");
+ my $tasks = $conn->tasks();
+ my $oldcount = @$tasks;
+ "ZOOM::IRSpy::Test::$tname"->start($conn);
+ $tasks = $conn->tasks();
+ if (@$tasks > $oldcount) {
+ # Prepare to start the first of the newly added tasks
+ $conn->next_task($tasks->[$oldcount]);
+ } else {
+ $conn->log("irspy_task",
+ "no tasks added by new test $tname");
+ goto NEXT_TEST;
+ }
+ }
+
+ my $task = $conn->next_task();
+ die "no next task queued for $conn" if !defined $task;
+ $conn->log("irspy_task", "preparing task $task");
+ $conn->next_task(0);
+ $conn->current_task($task);
+ $task->run();
+ }
+
+ # Do we need to test $conn->is_idle()? I don't think so!
+ }
+
+ my $i0 = ZOOM::event(\@conn);
+ $this->log("irspy_event",
+ "ZOOM_event(", scalar(@conn), " connections) = $i0");
+ last if $i0 == 0 || $i0 == -3; # no events or no connections
+ my $conn = $conn[$i0-1];
+ my $ev = $conn->last_event();
+ my $evstr = ZOOM::event_str($ev);
+ $conn->log("irspy_event", "event $ev ($evstr)");
+
+ my $task = $conn->current_task();
+ die "$conn has no current task for event $ev ($evstr)" if !$task;
+ eval { $conn->_check() };
+ if ($@ &&
+ ($ev == ZOOM::Event::RECV_DATA ||
+ $ev == ZOOM::Event::RECV_APDU ||
+ $ev == ZOOM::Event::ZEND)) {
+ # An error in, say, a search response, becomes visible to
+ # ZOOM before the Receive Data event is sent and persists
+ # until after the End, which means that successive events
+ # each report the same error. So we just ignore errors on
+ # "unimportant" events. ### But this doesn't work for,
+ # say, a Connection Refused, as the only event that shows
+ # us this error is the End.
+ $conn->log("irspy_event", "ignoring error ",
+ "on event $ev ($evstr): $@");
+ next;
+ }
+
+ my $res;
+ if ($@) {
+ my $sub = $task->{cb}->{exception};
+ die $@ if !defined $sub;
+ $res = &$sub($conn, $task, $task->udata(), $@);
+ } else {
+ my $sub = $task->{cb}->{$ev};
+ if (!defined $sub) {
+ $conn->log("irspy_unhandled", "event $ev ($evstr)");
+ next;
+ }
+
+ $res = &$sub($conn, $task, $task->udata(), $ev);
+ }