[svn:modperl-modules] rev 140 - Apache-Scoreboard-2.0/trunk/t/response/TestApache

[email protected] 7 Feb 2005 03:20:28 -0000
Newsgroups perl.modperl.modules.svn
Message-ID <[email protected]>
Author: stas
Date: Sun Feb  6 19:20:28 2005
New Revision: 140

Modified:
   Apache-Scoreboard-2.0/trunk/t/response/TestApache/scoreboard.pm
Log:
improve image_is_ok


Modified: Apache-Scoreboard-2.0/trunk/t/response/TestApache/scoreboard.pm
==============================================================================
--- Apache-Scoreboard-2.0/trunk/t/response/TestApache/scoreboard.pm	(original)
+++ Apache-Scoreboard-2.0/trunk/t/response/TestApache/scoreboard.pm	Sun Feb  6 19:20:28 2005
@@ -6,6 +6,7 @@
 use Apache::Test;
 use Apache::TestUtil;
 use Apache::TestTrace;
+use Apache::TestRequest ();
 
 use Apache::Response ();
 use Apache::RequestRec;
@@ -25,7 +26,6 @@
     times start_time stop_time
 );
 
-
 my $cfg = Apache::Test::config();
 my $vars = $cfg->{vars};
 
@@ -54,7 +54,7 @@
 
     # get the image internally
     my $image = Apache::Scoreboard->image($r->pool);
-    ok $image && ref $image;
+    ok image_is_ok($image);
 
     # now fetch the image via lwp and run a few basic tests
     # need to have two availble workers, otherwise it'll hang
@@ -179,16 +179,24 @@
     Apache::OK;
 }
 
-# try to access various underlaying datastructures to test that the
+# try to access various underlying datastructures to test that the
 # image is valid
 sub image_is_ok {
     my ($image) = shift;
-    return $image &&
-           ref $image &&
-           $image->pids &&
-           $image->worker_score(0, 0)->status &&
-           $image->parent_score &&
-           $image->parent_score->worker_score->vhost;
+    my $status = 1;
+    $status = 0 unless $image && 
+        ref($image) eq 'Apache::Scoreboard' &&
+        $image->pids &&
+        $image->worker_score(0, 0)->status &&
+        $image->parent_score &&
+        $image->parent_score->worker_score->vhost;
+
+    # check that we don't segfault here
+    #for (my $proc = $image->parent; $proc; $proc = $proc->next) {
+    #    my $pid = $proc->pid;
+    #}
+
+    return $status;
 }
 
 # check that all worker_score props return something