The test framework

From knutroy at projects.linpro.no Wed Sep 5 12:49:05 2007 From: knutroy at projects.linpro.no (knutroy at projects.linpro.no) Date: Wed, 5 Sep 2007 14:49:05 +0200 (CEST) Subject: r1937 - in trunk/varnish-tools/regress: . bin lib/Varnish lib/Varnish/Test lib/Varnish/Test/Server Message-ID: <20070905124905.B8A5A1EC3DD@projects.linpro.no> Author: knutroy Date: 2007-09-05 14:49:05 +0200 (Wed, 05 Sep 2007) New Revision: 1937 Added: trunk/varnish-tools/regress/lib/Varnish/Test/Server/ trunk/varnish-tools/regress/lib/Varnish/Test/Server/Connection.pm Removed: trunk/varnish-tools/regress/TODO Modified: trunk/varnish-tools/regress/ trunk/varnish-tools/regress/bin/varnish-regress.pl trunk/varnish-tools/regress/lib/Varnish/Test.pm trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm trunk/varnish-tools/regress/lib/Varnish/Test/Varnish.pm Log: * Added POD. * Moved Varnish::Test::Server::Connection to its own module file. * Removed TODO which was not too exciting anyway. Property changes on: trunk/varnish-tools/regress ___________________________________________________________________ Name: svn:ignore + Makefile Deleted: trunk/varnish-tools/regress/TODO =================================================================== --- trunk/varnish-tools/regress/TODO 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/TODO 2007-09-05 12:49:05 UTC (rev 1937) @@ -1,2 +0,0 @@ -* Completely POD-ify Perl-code. -* Detect and act upon unexpected death of Varnish grandchild process. Modified: trunk/varnish-tools/regress/bin/varnish-regress.pl =================================================================== --- trunk/varnish-tools/regress/bin/varnish-regress.pl 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/bin/varnish-regress.pl 2007-09-05 12:49:05 UTC (rev 1937) @@ -32,6 +32,27 @@ varnish-regress.pl - run Varnish regression tests +=head1 DESCRIPTION + +This program is a thin wrapper around the L regression +test framework library. Using this library, regression tests are +performed on Varnish. + +The Varnish daemon (L) must be available in one of the +directories given by the "PATH" environment variable. + +By default, this program will run all test-cases available in the +regression test framework library, or the test-cases selected by name +as arguments on the command line. + +=head1 OUTPUT + +STDERR is used to continually report progress during testing. + +STDOUT is used to output a HTML-formatted report at the end of the +run, provided that execution does not abort prematurely for any +reason. + =cut use strict; @@ -96,5 +117,6 @@ =head1 SEE ALSO L +L =cut Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm =================================================================== --- trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm 2007-09-05 12:49:05 UTC (rev 1937) @@ -34,14 +34,16 @@ =head1 DESCRIPTION -Varnish::Test::Case is meant to be the superclass of specific -test-case clases. It provides functionality to run a number of tests -defined in methods whose names start with "test", as well as keeping -track of the number of successful or failed tests. +Varnish::Test::Case is the superclass of test-case clases. It provides +functionality to run a number of tests defined in methods whose names +start with "test", as well as keeping track of the number of +successful or failed tests. It also provides default event handlers for "ev_client_response" and "ev_client_timeout", which are standard for most test-cases. +=head1 METHODS + =cut package Varnish::Test::Case; @@ -54,6 +56,12 @@ use POSIX qw(strftime); use Time::HiRes qw(gettimeofday tv_interval); +=head2 new + +Create a new Case object. + +=cut + sub new($$) { my ($this, $engine) = @_; my $class = ref($this) || $this; @@ -64,12 +72,25 @@ 'failed' => 0 }, $class); } +=head2 log + +Logging facility. + +=cut + sub log($$) { my ($self, $str) = @_; $self->{'engine'}->log($self, 'CAS: ', $str); } +=head2 init + +Test-case initialization which loads specified VCL into Varnish and +starts the Varnish daemon's child. + +=cut + sub init($) { my ($self) = @_; my ($code, $text); @@ -105,6 +126,13 @@ } } +=head2 fini + +Does the reverse of "init" by stopping the Varnish child and reverting +to a default VCL definition. + +=cut + sub fini($) { my ($self) = @_; @@ -127,6 +155,12 @@ } } +=head2 run + +Run test-case proper when everything is set up right. + +=cut + sub run($;@) { my ($self, @args) = @_; @@ -162,18 +196,37 @@ $self->{'stop'} = [gettimeofday()]; } +=head2 run_loop + +Proxy for Varnish::Test::Engine::run_loop. + +=cut + sub run_loop($@) { my ($self, @wait_for) = @_; return $self->{'engine'}->run_loop(@wait_for); } +=head2 new_client + +Creates a new Client object. + +=cut + sub new_client($) { my ($self) = @_; return Varnish::Test::Client->new($self->{'engine'}); } +=head2 results + +Report test-case results as a hashref suitable for Template +processing. + +=cut + sub results($) { my ($self) = @_; @@ -196,12 +249,22 @@ # Default event handlers # +=head1 DEFAULT EVENT HANDLER METHODS + +=head2 ev_client_response + +=cut + sub ev_client_response($$$) { my ($self, $client, $response) = @_; return $response; } +=head2 ev_client_timeout + +=cut + sub ev_client_timeout($$) { my ($self, $client) = @_; @@ -209,6 +272,10 @@ return $client; } +=head2 ev_server_request + +=cut + sub ev_server_request($$$$) { my ($self, $server, $connection, $request) = @_; @@ -237,6 +304,10 @@ $connection->send_response($response); } +=head2 ev_server_timeout + +=cut + sub ev_server_timeout($$) { my ($self, $srvconn) = @_; @@ -248,6 +319,16 @@ # Client utilities # +=head1 CLIENT UTILITY METHODS + +=head2 request + +Prepare and send an HTTP request using Client object given as +argument. Also, HTTP method, URI, HTTP headers and content are given +as argument. HTTP headers and content is optional. + +=cut + sub request($$$$;$$) { my ($self, $client, $method, $uri, $header, $content) = @_; @@ -279,18 +360,40 @@ return $self->{'cached_response'} = $resp; } +=head2 head + +Send "HEAD" request using "request" method above. Client object, URI, +and HTTP headers (optional) are given as arguments. + +=cut + sub head($$$;$) { my ($self, $client, $uri, $header) = @_; return $self->request($client, 'HEAD', $uri, $header); } +=head2 get + +Send "GET" request using "request" method above. Client object, URI, +and HTTP headers (optional) are given as arguments. + +=cut + sub get($$$;$) { my ($self, $client, $uri, $header) = @_; return $self->request($client, 'GET', $uri, $header); } +=head2 post + +Send "POST" request using "request" method above. Client object, URI, +and HTTP headers (optional) and body (optional) are given as +arguments. + +=cut + sub post($$$;$$) { my ($self, $client, $uri, $header, $body) = @_; @@ -299,6 +402,18 @@ return $self->request($client, 'POST', $uri, $header, $body); } +=head1 ASSERT METHODS + +The following assert methods take an optional response object is their +last argument. When this argument is not used, response object is +looked up in $self->{'cached_response'}. + +=head2 assert_code + +Assert a certain HTTP status code. + +=cut + sub assert_code($$;$) { my ($self, $code, $resp) = @_; @@ -308,6 +423,12 @@ unless $resp->code == $code; } +=head2 assert_ok + +Assert status "200 OK" using "assert_code" method above. + +=cut + sub assert_ok($;$) { my ($self, $resp) = @_; @@ -317,6 +438,12 @@ $self->assert_code(200, $resp); } +=head2 assert_xid + +Assert a certain XID in "X-Varnish" header. + +=cut + sub assert_xid($;$) { my ($self, $resp) = @_; @@ -329,6 +456,12 @@ unless ($resp->header('X-Varnish') =~ m/^\d+(?: \d+)?$/); } +=head2 assert_no_xid + +Assert absence of "X-Varnish" header. + +=cut + sub assert_no_xid($;$) { my ($self, $resp) = @_; @@ -339,6 +472,12 @@ if (defined($resp->header('X-Varnish'))); } +=head2 assert_cached + +Assert that "X-Varnish" header indicates that the response was cached. + +=cut + sub assert_cached($;$) { my ($self, $resp) = @_; @@ -350,6 +489,13 @@ unless $resp->header('X-Varnish') =~ /^\d+ \d+$/; } +=head2 assert_uncached + +Assert that "X-Varnish" header indicates that the response was NOT +cached. + +=cut + sub assert_uncached($;$) { my ($self, $resp) = @_; @@ -361,6 +507,13 @@ if $resp->header('X-Varnish') =~ /^\d+ \d+$/; } +=head2 assert_header + +Assert that a certain header (named by an argument) is present, and +optionally matches a given regular expression. + +=cut + sub assert_header($$;$$) { my ($self, $header, $re, $resp) = @_; @@ -375,6 +528,13 @@ } } +=head2 assert_body + +Assert presence of a HTTP body, optionally matching given regular +expression. + +=cut + sub assert_body($;$$) { my ($self, $re, $resp) = @_; @@ -389,6 +549,12 @@ } } +=head2 assert_no_body + +Assert absence of HTTP body. + +=cut + sub assert_no_body($;$) { my ($self, $resp) = @_; @@ -402,6 +568,14 @@ # Miscellaneous # +=head1 MISCELLANEOUS METHODS + +=head2 usleep + +Sleep for a given number of microseconds. + +=cut + sub usleep($$) { my ($self, $usec) = @_; @@ -409,3 +583,11 @@ } 1; + +=head1 SEE ALSO + +L +L +L + +=cut Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm =================================================================== --- trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm 2007-09-05 12:49:05 UTC (rev 1937) @@ -44,9 +44,17 @@ use strict; use IO::Socket::INET; +use HTTP::Response; our $id_seq = 1; +=head2 new + +Called by test-cases to create a new Client object to be used to send +HTTP-requests. + +=cut + sub new($$) { my ($this, $engine, $attrs) = @_; my $class = ref($this) || $this; @@ -62,18 +70,36 @@ return $self; } +=head2 log + +Logging facility. + +=cut + sub log($$;$) { my ($self, $str, $extra_prefix) = @_; $self->{'engine'}->log($self, sprintf('CLI[%d]: ', $self->{'id'}) . ($extra_prefix || ''), $str); } +=head2 logf + +Logging facility using a formatting string as first argument. + +=cut + sub logf($$;@) { my ($self, $fmt, @args) = @_; $self->{'engine'}->log($self, sprintf('CLI[%d]: ', $self->{'id'}), sprintf($fmt, @args)); } +=head2 send_request + +Called by test-cases to send HTTP requests out on a connection. + +=cut + sub send_request($$;$) { my ($self, $request, $timeout) = @_; @@ -93,6 +119,13 @@ $self->logf("%s %s %s", $request->method(), $request->uri(), $request->protocol()); } +=head2 got_response + +Called by mux_input and mux_eof to dispatch event related to received +HTTP response. + +=cut + sub got_response($$) { my ($self, $response) = @_; @@ -101,6 +134,13 @@ $self->{'engine'}->ev_client_response($self, $response); } +=head2 shutdown + +Called by test-cases to shutdown client including termination of HTTP +connection. + +=cut + sub shutdown($) { my ($self) = @_; @@ -119,6 +159,17 @@ } } +=head1 IO::MULTIPLEX CALLBACKS + +=head2 mux_input + +Called by L when new input is received on an associated +file-handle. Complete HTTP messages are extracted from the input +buffer, while any incomplete message is left in the buffer, awaiting +more input (mux_input) or EOF (mux_eof). + +=cut + sub mux_input($$$$) { my ($self, $mux, $fh, $data) = @_; @@ -197,6 +248,13 @@ # nothing at all or a partial HTTP message. } +=head2 mux_eof + +Called by L when connection is being shutdown by +foreign host. + +=cut + sub mux_eof($$$$) { my ($self, $mux, $fh, $data) = @_; @@ -210,6 +268,13 @@ } } +=head2 mux_timeout + +Called by L when a specified timeout has been reached +on an associated file-handle. + +=cut + sub mux_timeout($$$) { my ($self, $mux, $fh) = @_; @@ -217,6 +282,13 @@ $self->{'engine'}->ev_client_timeout($self); } +=head2 mux_close + +Called by L when an associated file-handle has been +closed. + +=cut + sub mux_close($$) { my ($self, $mux, $fh) = @_; @@ -224,3 +296,10 @@ } 1; + +=head1 SEE ALSO + +L +L + +=cut Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm =================================================================== --- trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/lib/Varnish/Test/Engine.pm 2007-09-05 12:49:05 UTC (rev 1937) @@ -34,15 +34,15 @@ =head1 DESCRIPTION -Varnish::Test::Engine is primarily a wrapper around a -IO::Multiplex-based select-loop which monitors activity on -client-side, server-side and Varnish's I/O-channels. On startup, it -automatically creates an associated Server object and a Varnish -objects whoses sockets/filehandles are registered in the -IO::Multiplex-object. +An L object is primarily a wrapper +around a L-based L object which monitors +activity on relevant sockets and file handles. -Additionally, event dispatching is performed by the AUTOLOAD method. +Additionally, an Engine object performs event dispatching and queuing, +which are handled by an AUTOLOAD method. +=head1 METHODS + =cut package Varnish::Test::Engine; @@ -53,6 +53,16 @@ use Varnish::Test::Varnish; use IO::Multiplex; +=head2 new + +Used by main program to create a new Varnish::Test::Engine object +which starts up a L and +L object, so test-cases are ready to be run. +Also an object is started to handle the central +select(2) mechanism. + +=cut + sub new($$;%) { my ($this, $controller, %config) = @_; my $class = ref($this) || $this; @@ -83,6 +93,12 @@ return $self; } +=head2 log + +Logging facility. + +=cut + sub log($$$) { my ($self, $object, $prefix, $str) = @_; @@ -92,6 +108,14 @@ print STDERR $str; } +=head2 run_loop + +Enter event loop based on IO::Multiplex::loop. Also, handles +dispatching of "wait-for" or "die" events which are returned to the +caller. + +=cut + sub run_loop($@) { my ($self, @wait_for) = @_; @@ -145,6 +169,13 @@ return undef; } +=head2 shutdown + +Shutdown Engine by shutting down Server, Varnish, and IO::Multiplex +objects. + +=cut + sub shutdown($) { my ($self) = @_; @@ -158,7 +189,17 @@ } } -sub AUTOLOAD ($;@) { +=head2 AUTOLOAD + +Event dispatch mechanism. When an I/O event occurs, it goes through +this method because $engine->ev_* resolves to this one. It will the +look for a method of the same name in the running test-case object. +Queuing and end-loop signaling is done when a "wait-for" or "die" +event occurs. + +=cut + +sub AUTOLOAD($;@) { my ($self, @args) = @_; (my $event = our $AUTOLOAD) =~ s/.*://; @@ -209,3 +250,11 @@ } 1; + +=head1 SEE ALSO + +L +L +L + +=cut Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm =================================================================== --- trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm 2007-09-04 14:00:13 UTC (rev 1936) +++ trunk/varnish-tools/regress/lib/Varnish/Test/Report.pm 2007-09-05 12:49:05 UTC (rev 1937) @@ -28,12 +28,32 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Report + +=head1 DESCRIPTION + +Produce test result reports in different formats. Currently, HTML +format is supported via a subclass found in +Varnish::Test::Report::HTML. + +=head1 METHODS + +=cut + package Varnish::Test::Report; use strict; use Template; +=head2 new + +Create a new Report object. + +=cut + sub new($) { my ($this) = @_; my $class = ref($this) || $this; @@ -51,6 +71,12 @@ return $self; } +=head2 new + +Generate report. + +=cut + sub run($@) { my ($self, @cases) = @_; @@ -75,3 +101,9 @@ } 1; + +=head1 SEE ALSO + +L