+ my $topname = $this->{tree}->name();
+ my $timeout = $this->{timeout};
+ $this->log("irspy", "beginnning with test '$topname' (timeout $timeout)");
+
+ my $nskipped = 0;
+ my @conn = @{ $this->{connections} };
+
+ my $nruns = 0;
+ ROUND_AND_ROUND_WE_GO:
+ 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";
+ next if !defined $conn;
+
+ 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 {
+ $conn->log("irspy_test",
+ "checking for next test after '$address'");
+ $nextaddr = $this->_next_test($address);
+ }
+
+ if (ZOOM::IRSpy::Test::zoom_error_timeout_check($conn)) {
+ $conn->log("irspy", "Got to many timeouts, stop testing");
+ undef $nextaddr;
+ }
+
+ if (!defined $nextaddr) {
+ $conn->log("irspy", "has no more tests: removing");
+ $this->_rewrite_irspy_record($conn);
+ $conn->option(rewrote_record => 1);
+ my $newconn = $this->_next_connection();
+ if (!defined $newconn) {
+ # Do not destroy: needed for later sanity checks
+ splice @conn, $i0, 1;
+ } else {
+ $conn->destroy();
+ $conn[$i0] = $newconn;
+ $conn[$i0]->option(current_test_address => "");
+ $conn[$i0]->log("irspy", "entering active pool - ",
+ scalar(@{ $this->{queue} }),
+ " targets remain in queue");
+ }
+ next;
+ }
+
+ my $node = $this->{tree}->select($nextaddr)
+ or die "invalid nextaddr '$nextaddr'";
+ $conn->option(current_test_address => $nextaddr);
+ my $tname = $node->name();
+ if ($this->should_skip_test($tname)) {
+ $conn->log("irspy_test",
+ "skipping test '$nextaddr' = $tname due to rule");
+ $nskipped += 1;
+ goto NEXT_TEST;
+ }
+
+ $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;
+
+ # do not run the next task if we got too many timeouts
+ if (ZOOM::IRSpy::Test::zoom_error_timeout_check($conn)) {
+ $conn->log("irspy_task", "Got too many timeouts for this target, do not start a new task");
+ next;
+ }
+
+ $conn->log("irspy_task", "preparing task $task");
+ $conn->next_task(0);
+ $conn->current_task($task);
+ $task->run();
+ }
+ }
+
+ NEXT_EVENT:
+ my $i0 = ZOOM::event(\@conn);
+ $this->log("irspy_event",
+ "ZOOM_event(", scalar(@conn), " connections) = $i0");
+ if ($i0 < 1) {
+ my %messages = (
+ 0 => "no events remain",
+ -1 => "ZOOM::event() argument not a reference",
+ -2 => "ZOOM::event() reference not an array",
+ -3 => "no connections remain",
+ -4 => "too many connections for ZOOM::event()",
+ );
+ my $message = $messages{$i0} || "ZOOM::event() returned $i0";
+ $this->log("irspy", $message);
+ last;
+ }
+
+ my $conn = $conn[$i0-1];
+ my $ev = $conn->last_event();
+ my $evstr = ZOOM::event_str($ev);
+ $conn->log("irspy_event", "event $ev ($evstr)");
+ goto NEXT_EVENT if $ev != ZOOM::Event::ZEND;
+
+ my $task = $conn->current_task();
+ die "$conn has no current task for event $ev ($evstr)" if !$task;
+
+ my $res;
+ eval { $conn->check() };
+ if ($@ && ref $@ && $@->isa("ZOOM::Exception")) {
+ my $sub = $task->{cb}->{exception};
+ die $@ if !defined $sub;
+ $res = &$sub($conn, $task, $task->udata(), $@);
+ } elsif ($@) {
+ die "Unexpected non-ZOOM exception: " . ref($@) . " ($@)";
+ } else {
+ my $sub = $task->{cb}->{$ev};
+ if (!defined $sub) {
+ $conn->log("irspy_unhandled", "event $ev ($evstr)");
+ next;
+ }
+
+ $res = &$sub($conn, $task, $task->udata(), $ev);
+ }
+
+ if ($res == ZOOM::IRSpy::Status::OK) {
+ # Nothing to do -- life continues
+
+ } elsif ($res == ZOOM::IRSpy::Status::TASK_DONE) {
+ my $task = $conn->current_task();
+ die "no task for TASK_DONE on $conn" if !$task;
+ die "next task already defined for $conn" if $conn->next_task();
+ $conn->log("irspy_task", "completed task $task");
+ $conn->next_task($task->{next});
+ $conn->current_task(0);
+
+ } elsif ($res == ZOOM::IRSpy::Status::TEST_GOOD ||
+ $res == ZOOM::IRSpy::Status::TEST_BAD) {
+ my $x = ($res == ZOOM::IRSpy::Status::TEST_GOOD) ? "good" : "bad";
+ $conn->log("irspy_task", "test ended during task $task ($x)");
+ $conn->log("irspy_test", "test completed ($x)");
+ $conn->current_task(0);
+ $conn->next_task(0);
+ if ($res == ZOOM::IRSpy::Status::TEST_BAD) {
+ my $address = $conn->option('current_test_address');
+ $conn->log("irspy", "top-level test failed!")
+ if $address eq "";
+ my $node = $this->{tree}->select($address);
+ my $skipcount = 0;
+ while (defined $node->next() &&
+ length($node->next()->address()) >= length($address)) {
+ $conn->log("irspy_test", "skipping from '",
+ $node->address(), "' to '",
+ $node->next()->address(), "'");
+ $node = $node->next();
+ $skipcount++;
+ }
+
+ $conn->option(current_test_address => $node->address());
+ $conn->log("irspy_test", "skipped $skipcount tests");
+ $nskipped += $skipcount;
+ }
+
+ } elsif ($res == ZOOM::IRSpy::Status::TEST_SKIPPED) {
+ $conn->log("irspy_test", "test skipped during task $task");
+ $conn->current_task(0);
+ $conn->next_task(0);
+ $nskipped++;
+
+ } else {
+ die "unknown callback return-value '$res'";
+ }
+ }
+
+ $this->log("irspy", "exiting main loop");
+
+ # Sanity checks: none of the following should ever happen
+ my $finished = 1;
+ $this->log("irspy", "performing end-of-run sanity-checks");
+ foreach my $conn (@conn) {
+ my $test = $conn->option("current_test_address");
+ my $next = $this->_next_test($test);
+ if (defined $next) {
+ $this->log("irspy",
+ "$conn (in test '$test') has queued test '$next'");
+ $finished = 0;
+ }
+ if (my $task = $conn->current_task()) {
+ $this->log("irspy", "$conn still has an active task $task");
+ $finished = 0;
+ }
+ if (my $task = $conn->next_task()) {
+ $this->log("irspy", "$conn still has a queued task $task");
+ $finished = 0;
+ }
+ if (!$conn->is_idle()) {
+ $this->log("irspy",
+ "$conn still has ZOOM-C level tasks queued: see below");
+ $finished = 0;
+ }
+ my $ev = $conn->peek_event();
+ if ($ev != 0 && $ev != ZOOM::Event::ZEND) {
+ my $evstr = ZOOM::event_str($ev);
+ $this->log("irspy", "$conn has event $ev ($evstr) waiting");
+ $finished = 0;
+ }
+ if (!$conn->option("rewrote_record")) {
+ $this->log("irspy", "$conn did not rewrite its ZeeRex record");
+ $finished = 0;
+ }