From: Mike Taylor <mike@indexdata.com>
Date: Thu, 15 Mar 2007 11:38:14 +0000 (+0000)
Subject: Fix result-set leak.
X-Git-Tag: CPAN-v1.02~531
X-Git-Url: http://sru.miketaylor.org.uk/?a=commitdiff_plain;h=adf4375f42066dd4498c08b68b9a784dd4ea7eac;p=irspy-moved-to-github.git

Fix result-set leak.
---

diff --git a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
index 320f9ca..71de6fe 100644
--- a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
+++ b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
@@ -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;
 }
 
diff --git a/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm b/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
index 61596ae..fc1cc64 100644
--- a/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
+++ b/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
@@ -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;
 }
 
diff --git a/lib/ZOOM/IRSpy/Test/Search/Boolean.pm b/lib/ZOOM/IRSpy/Test/Search/Boolean.pm
index 7289a37..8d3e5bb 100644
--- a/lib/ZOOM/IRSpy/Test/Search/Boolean.pm
+++ b/lib/ZOOM/IRSpy/Test/Search/Boolean.pm
@@ -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);
diff --git a/lib/ZOOM/IRSpy/Test/Search/Dan1.pm b/lib/ZOOM/IRSpy/Test/Search/Dan1.pm
index 0c3ce35..51b6607 100644
--- a/lib/ZOOM/IRSpy/Test/Search/Dan1.pm
+++ b/lib/ZOOM/IRSpy/Test/Search/Dan1.pm
@@ -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);
diff --git a/lib/ZOOM/IRSpy/Test/Search/Explain.pm b/lib/ZOOM/IRSpy/Test/Search/Explain.pm
index 299ee69..28a18da 100644
--- a/lib/ZOOM/IRSpy/Test/Search/Explain.pm
+++ b/lib/ZOOM/IRSpy/Test/Search/Explain.pm
@@ -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);