Fix result-set leak.
authorMike Taylor <mike@indexdata.com>
Thu, 15 Mar 2007 11:38:14 +0000 (11:38 +0000)
committerMike Taylor <mike@indexdata.com>
Thu, 15 Mar 2007 11:38:14 +0000 (11:38 +0000)
lib/ZOOM/IRSpy/Test/Record/Fetch.pm
lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
lib/ZOOM/IRSpy/Test/Search/Boolean.pm
lib/ZOOM/IRSpy/Test/Search/Dan1.pm
lib/ZOOM/IRSpy/Test/Search/Explain.pm

index 320f9ca..71de6fe 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Fetch.pm,v 1.26 2007-02-24 01:27:20 mike Exp $
+# $Id: Fetch.pm,v 1.27 2007-03-15 11:38:14 mike Exp $
 
 # See the "Main" test package for documentation
 
@@ -42,6 +42,7 @@ sub completed_search {
               ref $event && $event->isa("ZOOM::Exception") ?
               "failed: $event" : "found $n records (event=$event)");
     if ($n == 0) {
+       $task->{rs}->destroy();
        my $qindex = $udata->{queryindex}+1;
        my $q = $queries[$qindex];
        return ZOOM::IRSpy::Status::TEST_SKIPPED
@@ -116,6 +117,7 @@ sub record {
                                   'syntax'   => $syn,
                                   'ok'       => $ok);
 
+    $rs->destroy() if $udata->{last};
     return ($udata->{last} ?
            ZOOM::IRSpy::Status::TEST_GOOD :
            ZOOM::IRSpy::Status::TASK_DONE);
@@ -143,13 +145,14 @@ sub __UNUSED_search_error {
 
 
 sub fetch_error {
-    my($conn, $task, $test_args, $exception) = @_;
-    my $syn = $test_args->{'syntax'};
+    my($conn, $task, $udata, $exception) = @_;
+    my $syn = $udata->{'syntax'};
 
     $conn->log("irspy_test", "Retrieval of $syn record failed: ", $exception);
     $conn->record()->store_result('record_fetch',
                                   'syntax'       => $syn,
                                   'ok'        => 0);
+    $task->{rs}->destroy() if $udata->{last};
     return ZOOM::IRSpy::Status::TASK_DONE;
 }
 
index 61596ae..fc1cc64 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Named.pm,v 1.4 2007-03-08 14:51:01 mike Exp $
+# $Id: Named.pm,v 1.5 2007-03-15 11:38:53 mike Exp $
 
 # See the "Main" test package for documentation
 
@@ -19,7 +19,7 @@ sub start {
     $conn->log('irspy_test', 'Testing for named resultset support');
 
     $conn->irspy_search_pqf("\@attr 1=4 mineral", {},
-                            {'setname' => 'a', 'start' => 0, 'count' => 0},    
+                            {'setname' => 'a', 'start' => 0, 'count' => 0},
                            ZOOM::Event::ZEND, \&completed_search_a,
                            exception => \&error);
 }
@@ -31,13 +31,17 @@ sub completed_search_a {
     my $record = '';
     my $hits = $rs->size();
 
-    ## How should we handle the situation when there is 0 hits?
-    if ($hits > 0) {
+    if ($hits == 0) {
+       ### We should try other searches as in Record::Fetch
+       $rs->destroy();
+       return ZOOM::IRSpy::Status::TEST_BAD;   
+    } else {
        my $rsrec = $rs->record(0);
        if (!defined $rsrec) {
            # I thought this was a "can't happen", but it sometimes
            # does, as for example documented for
            # kat.vkol.cz:9909/svk02 at ../../../../../tmp/bad-run-1
+           $rs->destroy();
            eval { $conn->check() };
            return error($conn, $task, $test_args, $@);
        }
@@ -61,12 +65,16 @@ sub completed_search_b {
     my $record = '';
     my $error = '';
 
+    $task->{rs}->destroy();    # We only care about the original search
     $rs->cache_reset();
 
-    if ($test_args->{'hits_a'} > 0) {
+    if ($test_args->{'hits_a'} == 0) {
+       die "can't happen: hits_a == 0";
+    } else {
         my $hits = $rs->size();
        my $rsrec = $rs->record(0);
        if (!defined $rsrec) {
+           $rs->destroy();
            eval { $conn->check() };
            return error($conn, $task, $test_args, $@);
        }
@@ -87,6 +95,7 @@ sub completed_search_b {
 
     update($conn, $error eq '' ? 1 : 0, $error);
 
+    $rs->destroy();
     return ZOOM::IRSpy::Status::TASK_DONE;
 }
 
index 7289a37..8d3e5bb 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Boolean.pm,v 1.4 2007-02-23 15:03:44 mike Exp $
+# $Id: Boolean.pm,v 1.5 2007-03-15 11:40:39 mike Exp $
 
 # See the "Main" test package for documentation
 
@@ -34,8 +34,9 @@ sub start {
 sub found {
     my($conn, $task, $test_args, $event) = @_;
     my $operator = $test_args->{'operator'};
-    my $n = $task->{rs}->size();
 
+    my $n = $task->{rs}->size();
+    $task->{rs}->destroy();
     $conn->log("irspy_test", "search using boolean operator ", $operator,
                              " found $n record", $n==1 ? "" : "s");
     update($conn, $operator, 1);
@@ -48,6 +49,7 @@ sub error {
     my($conn, $task, $test_args, $exception) = @_;
     my $operator = $test_args->{'operator'};
 
+    $task->{rs}->destroy();
     $conn->log("irspy_test", "search using boolean operator ", $operator,
                              " had error: ", $exception);
     update($conn, $operator, 0);
index 0c3ce35..51b6607 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Dan1.pm,v 1.6 2007-02-23 15:03:44 mike Exp $
+# $Id: Dan1.pm,v 1.7 2007-03-15 11:40:52 mike Exp $
 
 # See the "Main" test package for documentation
 
@@ -30,8 +30,9 @@ sub start {
 sub found {
     my($conn, $task, $test_args, $event) = @_;
     my $attr = $test_args->{'attr'};
-    my $n = $task->{rs}->size();
 
+    my $n = $task->{rs}->size();
+    $task->{rs}->destroy();
     $conn->log("irspy_test", "search on access-point $attr found $n record",
               $n==1 ? "" : "s");
     update($conn, $attr, 1);
@@ -44,6 +45,7 @@ sub error {
     my($conn, $task, $test_args, $exception) = @_;
     my $attr = $test_args->{'attr'};
 
+    $task->{rs}->destroy();
     $conn->log("irspy_test", "search on access-point $attr had error: ",
               $exception);
     update($conn, $attr, 0);
index 299ee69..28a18da 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Explain.pm,v 1.6 2007-03-05 12:15:11 mike Exp $
+# $Id: Explain.pm,v 1.7 2007-03-15 11:41:24 mike Exp $
 
 # See the "Main" test package for documentation
 
@@ -34,14 +34,12 @@ sub start {
 sub found {
     my($conn, $task, $test_args, $event) = @_;
     my $category = $test_args->{'category'};
-    my $n = $task->{rs}->size();
-    my $ok = 0;
 
+    my $n = $task->{rs}->size();
+    $task->{rs}->destroy();
+    my $ok = ($n > 0);
     $conn->log("irspy_test", "Explain category ", $category, " gave ", $n,
                " hit(s).");
-    if ($n > 0) {
-        $ok = 1;
-    }
 
     update($conn, $category, $ok);
 
@@ -53,6 +51,7 @@ sub error {
     my($conn, $task, $test_args, $exception) = @_;
     my $category = $test_args->{'category'};
 
+    $task->{rs}->destroy();
     $conn->log("irspy_test", "Explain category lookup failed: ", $exception);
     update($conn, $category, 0);