--- /dev/null
+VARNISH REGRESSION TEST FRAMEWORK
+
+This is a regression test framework written in Perl. It is being
+tailored to the needs of the Varnish HTTP accelerator.
+
+The framework is based on interpreting a mini-language designed for
+this specific purpose. The mini-language expresses test case setups
+and conditions to be tested.
+
+The Perl-based interpreter sets up the run-time environment and
+executes a "program" written in this mini-language.
+
+The mini-language's grammar can be found in lib/Varnish/Test/Parser.pm
+which utilizes the Parse::RecDescent CPAN-module.
+
+The interpreter creates a run-time environment consisting of simulated
+clients and servers which live in the main process. In addition, it
+forks off a Varnish sub-process through which the clients and servers
+send HTTP-traffic. The main process uses a global select(2)-based loop
+(using IO::Multiplex) to which all the simulated clients and servers
+must relate. Hence, no threading is needed, but disciplined use
+sockets (to avoid blocking and other trouble) is required.
+
+When the mini-language is parsed, a tree of Perl-objects is created.
+There are classes representing:
+
+ * a server (Varnish::Test::Server)
+ * a client (Varnish::Test::Client)
+ * an accelerator/Varnish instance (Varnish::Test::Accelerator)
+ * a test-case (Varnish::Test::Case)
+ * a statement (Varnish::Test::Statement)
+ * an expression (Varnish::Test::Expression)
+ * a function invocation (Varnish::Test::Invocation)
+
+These classes share some properties which are found
+Varnish::Test::Object, most notably the ability to be "executed" and
+temporarily paused when the IO::Multiplex-loop needs to transfers
+control to another object.
+
+To keep track of execution, all objects have an attribute, "finished",
+which tells its parent whether execution has already terminated. In
+addition an attribute "return" is used to hold any return value should
+the object have a sensible return value to offer (which is the true
+for statements, expressions, and function invocations). Before
+"finished" is set to true, "return" has no meaning.
+
+The parent will execute its children sequentially, in the same order
+as they are defined in the source code.
+
+However, some objects get control back after they are "finished". This
+is the case for server objects when they serve requests, which happens
+asynchronously to ordinary execution and is orchestrated by the
+IO::Multiplex-loop. When the server object has handled the request,
+control returns to the original point of execution. Finding that point
+is done by skipping past all objects whose "finished"-attribute is
+true.
+
+Finally, the notion of scope and variables is taken care of by
+functionality provided in the super-class Varnish::Test::Context from
+which Varnish::Test::Object inherits.
--- /dev/null
+* Revise class hierarchy, possibly switching around
+ Varnish::Test::Context and Varnish::Test::Object since we might like
+ to inherit the properties of Object without getting the properties
+ of Context, in classes like Varnish::Test::Statement,
+ Varnish::Test::Expression, and Varnish::Test::Invocation.
+
+* Actually handle HTTP by utilizing Varnish::Test::Message (and
+ the sub-classes Varnish::Test::Request and Varnish::Test::Response)
+ as variables that live inside server and client objects.
+
+* Extend the language (syntax and semantics), to make it more
+ expressive and useful.
+
+* POD-ify Perl-code.
+
+* Fix IO::Multiplex-related warnings:
+
+ · Use of uninitialized value in unpack at /usr/share/perl5/IO/Multiplex.pm line 351.
+ Use of uninitialized value in numeric eq (==) at /usr/share/perl5/IO/Multiplex.pm line 351.
+
+ · Use of freed value in iteration at /usr/share/perl5/IO/Multiplex.pm line 721.
+
+ (Is this IO::Multiplex' or our fault?)
die("Parsing error.");
}
- print "###### SYNTAX TREE BEGIN ######\n";
- print Dumper $tree if defined($tree->{'body'});
- print "###### SYNTAX TREE END ######\n";
+ print STDERR "###### SYNTAX TREE BEGIN ######\n";
+ print STDERR Dumper $tree if defined($tree->{'body'});
+ print STDERR "###### SYNTAX TREE END ######\n";
$self->{'objects'} = [];
while (!$self->{'finished'}) {
&Varnish::Test::Object::run($self);
- print "Entering IO::Multiplex loop.\n";
+ print STDERR "Entering IO::Multiplex loop.\n";
$self->{'mux'}->loop;
}
- print "DONE.\n";
+ print STDERR "DONE.\n";
}
sub run($) {
use strict;
use base 'Varnish::Test::Object';
+use IO::Pipe;
use POSIX;
sub _init($) {
my $self = shift;
+ &Varnish::Test::Object::_init($self);
+
# Default address / port
$self->vars->{'address'} = 'localhost';
$self->vars->{'port'} = '8001';
}
+use Data::Dumper;
+
sub start($) {
my $self = shift;
$backend->isa('Varnish::Test::Server'))
or die("invalid server\n");
- my ($stdinx, $stdin) = POSIX::pipe()
- or die("pipe(): $!\n");
- my ($stdout, $stdoutx) = POSIX::pipe()
- or die("pipe(): $!\n");
- my ($stderr, $stderrx) = POSIX::pipe()
- or die("pipe(): $!\n");
+ my $stdin = new IO::Pipe;
+ my $stdout = new IO::Pipe;
+ my $stderr = new IO::Pipe;
my $pid = fork();
if (!defined($pid)) {
# fail
die("fork(): $!\n");
} elsif ($pid == 0) {
# child
- POSIX::dup2($stdinx, 0);
- POSIX::close($stdin);
- POSIX::close($stdinx);
- POSIX::dup2($stdoutx, 1);
- POSIX::close($stdout);
- POSIX::close($stdoutx);
- POSIX::dup2($stderrx, 2);
- POSIX::close($stderr);
- POSIX::close($stderrx);
+ $stdin->reader;
+ $stdout->writer;
+ $stderr->writer;
+
+ POSIX::dup2($stdin->fileno, 0);
+ $stdin->close;
+ POSIX::dup2($stdout->fileno, 1);
+ $stdout->close;
+ POSIX::dup2($stderr->fileno, 2);
+ $stderr->close;
# XXX must be in path
+ $ENV{'PATH'} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin';
exec('varnishd',
'-d', '-d',
+ '-a', $self->get('address') . ":" . $self->get('port'),
'-b', $backend->get('address') . ":" . $backend->get('port'));
exit(1);
}
# parent
+
+ $stdin->writer;
+ $stdout->reader;
+ $stderr->reader;
+
$self->{'pid'} = $pid;
$self->{'stdin'} = $stdin;
- POSIX::close($stdinx);
$self->{'stdout'} = $stdout;
- POSIX::close($stdoutx);
$self->{'stderr'} = $stderr;
- POSIX::close($stderrx);
+
+ # IO::Multiplex is going to issue some warnings here, because it
+ # does not handle non-socket file descriptors gently.
+
+ my $mux = $self->get_mux;
+ $mux->add($stdin);
+ $mux->set_callback_object($self, $stdin);
+ $mux->add($stdout);
+ $mux->set_callback_object($self, $stdout);
+ $mux->add($stderr);
+ $mux->set_callback_object($self, $stderr);
+
+ if ($self->has('vcl')) {
+ my $vcl = $self->get('vcl');
+ $vcl =~ s/\n/ /g;
+ $mux->write($stdin, "vcl.inline main " . $vcl . "\n");
+ }
}
sub stop($) {
my $self = shift;
- POSIX::close($self->{'stdin'})
- if ($self->{'stdin'});
- POSIX::close($self->{'stdout'})
- if ($self->{'stdout'});
- POSIX::close($self->{'stderr'})
- if ($self->{'stderr'});
+ my $mux = $self->get_mux;
+
+ foreach my $k ('stdin', 'stdout', 'stderr') {
+ if (defined($self->{$k})) {
+ $mux->close($self->{$k});
+ delete $self->{$k};
+ }
+ }
sleep(1);
kill(15, $self->{'pid'})
if ($self->{'pid'});
- delete($self->{'stdin'});
- delete($self->{'stdout'});
- delete($self->{'stderr'});
delete($self->{'pid'});
}
+sub run($) {
+ my $self = shift;
+
+ return if $self->{'finished'} or defined($self->{'pid'});
+
+ &Varnish::Test::Object::run($self);
+
+ $self->start;
+ $self->{'finished'} = 0;
+}
+
+sub shutdown($) {
+ my $self = shift;
+
+ $self->stop;
+}
+
+sub mux_input($$$$) {
+ my $self = shift;
+ my $mux = shift;
+ my $fh = shift;
+ my $data = shift;
+
+ print STDERR $$data;
+
+ if ($$data =~ /vcl.inline/) {
+ $mux->write($self->{'stdin'}, "start\n");
+ }
+
+ my $started = ($$data =~ /Child starts/);
+ $$data = '';
+
+ if ($started) {
+ $self->{'finished'} = 1;
+ $self->super_run;
+ }
+}
+
+sub mux_eof($$$$) {
+ my $self = shift;
+ my $mux = shift;
+ my $fh = shift;
+ my $data = shift;
+
+ $mux->close($fh);
+ foreach my $k ('stdin', 'stdout', 'stderr') {
+ if (defined($self->{$k}) && $self->{$k} == $fh) {
+ delete $self->{$k};
+ }
+ }
+}
+
1;
use strict;
use base 'Varnish::Test::Object';
+sub _init($) {
+ my $self = shift;
+
+ &Varnish::Test::Object::_init($self);
+
+ $self->set('assert', \&assert);
+}
+
sub run($) {
my $self = shift;
- print "Running case \"$self->{name}\"...\n";
+ if (!defined($self->{'started'})) {
+ print "Start of CASE \"$self->{name}\"...\n";
+ $self->{'started'} = 1;
+ }
&Varnish::Test::Object::run($self);
+
+ if ($self->{'finished'}) {
+ print "End of CASE \"$self->{name}\".\n";
+ }
+}
+
+sub assert($$) {
+ my $self = shift;
+ my $invocation = shift;
+
+ my $bool = $invocation->{'args'}[0]->{'return'};
+
+ if (!$bool) {
+ print " ASSERTION DOES NOT HOLD.\n";
+ }
+ else {
+ print " Assertion holds.\n";
+ }
+
+ $invocation->{'finished'} = 1;
}
1;
sub _init($) {
my $self = shift;
+ &Varnish::Test::Object::_init($self);
+
$self->set('protocol', '1.1');
$self->set('request', \&request);
}
$mux->add($fh);
$mux->set_callback_object($self, $fh);
- $mux->write($fh, "Hello\r\n");
- print "Client sent: Hello\n";
+ $mux->write($fh, "GET / HTTP/" . eval($self->get('protocol')) . "\r\n\r\n");
$self->{'request'} = $invocation;
}
my $mux = shift;
my $fh = shift;
my $data = shift;
+ my $response = new Varnish::Test::Context('response', $self);
$self->{'request'}->{'return'} = $$data;
- print "Client got: $$data";
+ if ($$data =~ 'HTTP/1.1') {
+ $response->set('protocol', '1.1');
+ }
+ else {
+ $response->set('protocol', '1.0');
+ }
+ print STDERR "Client got: $$data";
$$data = "";
$self->{'request'}->{'finished'} = 1;
delete $self->{'request'};
&Varnish::Test::Object::run($self);
+ my $expr = '';
+ my $seen_string = 0;
+ my $relational = 0;
+
if ($self->{'finished'} && defined($self->{'terms'})) {
- my $expr = '';
- my $return_as_string = 0;
foreach my $term (@{$self->{'terms'}}) {
my $term_value;
}
}
else {
+ if ($term eq '==' || $term eq '!='
+ || $term eq '<=' || $term eq '>='
+ || $term eq '<' || $term eq '>') {
+ $relational = 1;
+
+ if ($seen_string) {
+ if ($term eq '==') {
+ $term = 'eq';
+ }
+ elsif ($term eq '!=') {
+ $term = 'ne';
+ }
+ }
+ }
$term_value = $term;
}
return;
}
else {
- die "Found object/context reference in complex expression.";
+ $term_value = '"' . $term_value . '"';
}
}
if ($term_value =~ /^".*"$/s) {
- $return_as_string = 1;
+ $seen_string = 1;
}
$expr .= $term_value;
($expr) = $expr =~ /(.*)/s;
+ # print STDERR "Evaling: $expr\n";
+
$expr = eval $expr;
- if ($return_as_string) {
+ if ($seen_string && !$relational) {
$expr = '"' . $expr . '"';
}
if (!$self->{'in_call'}) {
$self->{'in_call'} = 1;
my ($func_ptr, $func_context) = $self->{'func_id'}->get_function($self);
- print "Calling " . $self->{'func_id'}->as_string, "\n";
+ # print STDERR "Calling " . $self->{'func_id'}->as_string, "\n";
&$func_ptr($func_context, $self);
}
}
sub _init($) {
my $self = shift;
+ &Varnish::Test::Object::_init($self);
+
$self->set('address', 'localhost');
$self->set('port', '9001');
}
my $fh = shift;
my $data = shift;
- print "Server got: $$data";
- $$data = "";
- $mux->write($fh, "HTTP/1.1 200 OK\r\n");
- print "Server sent: HTTP/1.1 200 OK\n";
+ $$data = ""; # Pretend we read the data.
+
+ my $response = "HTTP/" . eval($self->get('protocol')) . " 200 OK\r\n"
+ . "Content-Type: text/plain; charset=utf-8\r\n\r\n"
+ . eval($self->get('data')) . "\n";
+
+ $mux->write($fh, $response);
+ print STDERR "Server sent: " . $response;
$mux->shutdown($fh, 1);
}
}
}
+use Data::Dumper;
+
sub run($$) {
my $self = shift;
&Varnish::Test::Object::run($self);
if ($self->{'finished'}) {
- $self->{'lhs'}->set_value($self, $self->{'return'});
+ $self->{'lhs'}->set_value($self->{'parent'}, $self->{'return'});
}
}
comment = "client 1.0, server 1.0";
c1.protocol = "1.0";
s1.protocol = "1.0";
- c1.request(s1, "http://www.example.com/");
- c1.request(s1, "http://www.example.com/");
- c1.request(s1, "http://www.example.com/");
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.0");
+ }
+
+ case c10_s11 {
+ comment = "client 1.0, server 1.1";
+ c1.protocol = "1.0";
+ s1.protocol = "1.1";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.0");
+ }
+
+ case c11_s10 {
+ comment = "client 1.1, server 1.0";
+ c1.protocol = "1.1";
+ s1.protocol = "1.0";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.1");
+ }
+
+ case c11_s11 {
+ comment = "client 1.1, server 1.1";
+ c1.protocol = "1.1";
+ s1.protocol = "1.1";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.1");
}
}
projects / varnish / commitdiff