From: des Date: Wed, 10 Jan 2007 13:13:50 +0000 (+0000) Subject: Unfinished regression test framework which knutroy is taking over from me. X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=526d90c545f6be66f5b3110bf3edd46cba8f2f91;p=varnish Unfinished regression test framework which knutroy is taking over from me. git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1232 d4fa192b-c00b-0410-8231-f00ffab90ce4 --- diff --git a/varnish-tools/regress/lib/Varnish/Test.pm b/varnish-tools/regress/lib/Varnish/Test.pm new file mode 100644 index 00000000..2a6681ca --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test.pm @@ -0,0 +1,114 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test; + +use strict; +use base 'Varnish::Test::Context'; +use Varnish::Test::Accelerator; +use Varnish::Test::Case; +use Varnish::Test::Client; +use Varnish::Test::Server; +use Varnish::Test::Tokenizer; + +sub new($;$) { + my $this = shift; + my $class = ref($this) || $this; + + my $self = Varnish::Test::Context->new(); + bless($self, $class); + $self->parse($_[0]) + if (@_); + + return $self; +} + +sub _parse_ticket($$) { + my $self = shift; + my $t = shift; + + $t->shift_keyword("ticket"); + push(@{$self->{'ticket'}}, $t->shift("Integer")); + $t->shift("SemiColon"); +} + +sub _parse_test($$) { + my $self = shift; + my $t = shift; + + my $token = $t->shift_keyword("test"); + $token = $t->shift("String"); + $self->{'descr'} = $token->value; + $token = $t->shift("LeftBrace"); + for (;;) { + $token = $t->peek(); + last if $token->is("RightBrace"); + if (!$token->is("Keyword")) { + $t->die("expected keyword, got " . ref($token)); + } elsif ($token->value eq 'ticket') { + $self->_parse_ticket($t); + } elsif ($token->value eq 'accelerator') { + my $x = Varnish::Test::Accelerator->new($self, $t); + $t->die("duplicate declaration of " . $x->name) + if exists($self->{'vars'}->{$x->name}); + $self->set($x->name, $x); + } elsif ($token->value eq 'client') { + my $x = Varnish::Test::Client->new($self, $t); + $t->die("duplicate declaration of " . $x->name) + if exists($self->{'vars'}->{$x->name}); + $self->set($x->name, $x); + } elsif ($token->value eq 'server') { + my $x = Varnish::Test::Server->new($self, $t); + $t->die("duplicate declaration of " . $x->name) + if exists($self->{'vars'}->{$x->name}); + $self->set($x->name, $x); + } elsif ($token->value eq 'case') { + my $x = Varnish::Test::Case->new($self, $t); + } else { + $t->die("unexpected keyword " . $token->value); + } + } + $token = $t->shift("RightBrace"); +} + +sub parse($$) { + my $self = shift; + my $fn = shift; + + my $t = Varnish::Test::Tokenizer->new($fn); + $self->_parse_test($t); +} + +sub run($) { + my $self = shift; + +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Accelerator.pm b/varnish-tools/regress/lib/Varnish/Test/Accelerator.pm new file mode 100644 index 00000000..380ec239 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Accelerator.pm @@ -0,0 +1,108 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Accelerator; + +use strict; +use base 'Varnish::Test::Object'; +use POSIX; + +sub _init($) { + my $self = shift; + + # Default address / port + $self->vars->{'address'} = 'localhost'; + $self->vars->{'port'} = '8001'; +} + +sub start($) { + my $self = shift; + + my $backend = $self->vars->{'backend'}; + (defined($backend) && + $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 $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); + # XXX must be in path + exec('varnishd', + '-d', '-d', + '-b', $backend->get('address') . ":" . $backend->get('port')); + exit(1); + } + # parent + $self->{'pid'} = $pid; + $self->{'stdin'} = $stdin; + POSIX::close($stdinx); + $self->{'stdout'} = $stdout; + POSIX::close($stdoutx); + $self->{'stderr'} = $stderr; + POSIX::close($stderrx); +} + +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'}); + sleep(1); + kill(15, $self->{'pid'}) + if ($self->{'pid'}); + delete($self->{'stdin'}); + delete($self->{'stdout'}); + delete($self->{'stderr'}); + delete($self->{'pid'}); +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case.pm b/varnish-tools/regress/lib/Varnish/Test/Case.pm new file mode 100644 index 00000000..336fa457 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Case.pm @@ -0,0 +1,36 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Case; + +use strict; +use base 'Varnish::Test::Object'; + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Client.pm b/varnish-tools/regress/lib/Varnish/Test/Client.pm new file mode 100644 index 00000000..5c097c88 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Client.pm @@ -0,0 +1,55 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Client; + +use strict; +use base 'Varnish::Test::Object'; +use IO::Socket; +use URI; + +sub request($$$) { + my $self = shift; + my $server = shift; + my $url = shift; + + (defined($server) && + ($server->isa('Varnish::Test::Accelerator') || + $server->isa('Varnish::Test::Server'))) + or die("invalid server\n"); + $url = URI->new($url) + or die("invalid URL\n"); + + # GET $uri->path_query HTTP/$self->{'protocol'} + # Host: $uri->host_port + # Connection: xxx +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Code.pm b/varnish-tools/regress/lib/Varnish/Test/Code.pm new file mode 100644 index 00000000..7a6e45b4 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Code.pm @@ -0,0 +1,67 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Code; + +use strict; + +sub new($$$) { + my $this = shift; + my $class = ref($this) || $this; + my $context = shift; + + my $self = { + 'context' => $context, + }; + bless($self, $class); + + $self->_parse(shift) + if (@_); + + return $self; +} + +sub _parse($$) { + my $self = shift; + my $t = shift; + + print STDERR "\t"; + while (!$t->peek()->is("SemiColon")) { + print STDERR " " . $t->peek()->value(); + $t->shift(); + } + $t->shift("SemiColon"); + print STDERR ";\n"; +} + +sub run($) { +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Context.pm b/varnish-tools/regress/lib/Varnish/Test/Context.pm new file mode 100644 index 00000000..3692d3d8 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Context.pm @@ -0,0 +1,122 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Context; + +use strict; + +# +# A Context is an object that has a name, a type, and a set of named +# variables and procedures associated with it. A context may have a +# parent, from which it inherits variables and procedures. +# + +sub new($;$) { + my $this = shift; + my $class = ref($this) || $this; + my $parent = shift; + + my $self = { + 'parent' => $parent, + 'vars' => { }, + 'procs' => { }, + }; + bless($self, $class); + + return $self; +} + +sub parent($) { + my $self = shift; + + return $self->{'parent'}; +} + +sub vars($) { + my $self = shift; + + return $self->{'vars'}; +} + +sub procs($) { + my $self = shift; + + return $self->{'procs'}; +} + +sub set($$$) { + my $self = shift; + my $key = shift; + my $value = shift; + + if (!exists($self->vars->{$key}) && + $self->parent && $self->parent->has($key)) { + $self->parent->set($key, $value); + } else { + $self->vars->{$key} = $value; + } + return $value; +} + +sub has($$) { + my $self = shift; + my $key = shift; + + return exists($self->{'vars'}->{$key}) || + $self->parent->has($key); +} + +sub get($$) { + my $self = shift; + my $key = shift; + + return exists($self->vars->{$key}) ? $self->vars->{$key} : + ($self->parent && $self->parent->get($key)); +} + +sub type($) { + my $self = shift; + + if (!defined($self->{'type'})) { + ($self->{'type'} = ref($self)) =~ s/^(\w+::)*(\w+)$/$2/; + print STDERR "$self->{'type'}\n"; + } + return $self->{'type'}; +} + +sub name($;$) { + my $self = shift; + + $self->{'name'} = shift + if (@_); + return $self->{'name'}; +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Object.pm b/varnish-tools/regress/lib/Varnish/Test/Object.pm new file mode 100644 index 00000000..0b147526 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Object.pm @@ -0,0 +1,82 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Object; + +use strict; +use base 'Varnish::Test::Context'; +use Varnish::Test::Code; + +sub new($$;$) { + my $this = shift; + my $class = ref($this) || $this; + my $parent = shift; + + my $self = Varnish::Test::Context->new($parent); + $self->{'code'} = []; + bless($self, $class); + + $self->_init(); + + $self->_parse($_[0]) + if (@_); + + return $self; +} + +sub _init($) { + my $self = shift; + + # nothing +} + +sub _parse($$) { + my $self = shift; + my $t = shift; + + $t->shift_keyword(lc($self->type)); + $self->name($t->shift("Identifier")->value); + $t->shift("LeftBrace"); + while (!$t->peek()->is("RightBrace")) { + push(@{$self->{'code'}}, Varnish::Test::Code->new($self, $t)); +# $token = $t->shift("Identifier"); +# my $key = $token->value; +# $token = $t->shift("Assign"); +# $token = $t->shift("Integer", "Real", "String"); +# my $value = $token->value; +# $token = $t->shift("SemiColon"); +# $t->warn("multiple assignments to $self->{'name'}.$key") +# if ($self->has($key)); +# $self->set($key, $value); + } + $t->shift("RightBrace"); +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Request.pm b/varnish-tools/regress/lib/Varnish/Test/Request.pm new file mode 100644 index 00000000..8d304fba --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Request.pm @@ -0,0 +1,36 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Request; + +use strict; +use base 'Varnish::Test::Object'; + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Response.pm b/varnish-tools/regress/lib/Varnish/Test/Response.pm new file mode 100644 index 00000000..819319ca --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Response.pm @@ -0,0 +1,36 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Response; + +use strict; +use base 'Varnish::Test::Object'; + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Server.pm b/varnish-tools/regress/lib/Varnish/Test/Server.pm new file mode 100644 index 00000000..3512bf4d --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Server.pm @@ -0,0 +1,43 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Server; + +use strict; +use base 'Varnish::Test::Object'; + +sub _init($) { + my $self = shift; + + $self->vars->{'address'} = 'localhost'; + $self->vars->{'port'} = '9001'; +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Token.pm b/varnish-tools/regress/lib/Varnish/Test/Token.pm new file mode 100644 index 00000000..a40bea54 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Token.pm @@ -0,0 +1,168 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Token; + +use strict; + +# Common constructor +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $pos = shift; + + my $self = { + 'pos' => $pos, + 'value' => '???', + }; + bless($self, $class); + + # hack: use eval to avoid clobbering @_ + eval { ($self->{'type'} = $class) =~ s/^(\w+::)*(\w+)$/$2/; }; + + $self->init(@_); + + return $self; +} + +# Default initializer +sub init($;$) { + my $self = shift; + + $self->value(@_); +} + +sub type($;$) { + my $self = shift; + + $self->{'type'} = shift + if (@_); + return $self->{'type'}; +} + +sub value($;$) { + my $self = shift; + + $self->{'value'} = shift + if (@_); + return $self->{'value'}; +} + +sub is($$) { + my $self = shift; + my $type = shift; + + return ($self->{'type'} eq $type); +} + +sub equals($$) { + my $self = shift; + my $other = shift; + + return ($self->type() eq $other->type() && + $self->value() eq $other->value()); +} + +package Varnish::Test::Token::Assign; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Comma; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Compare; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::EOF; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Identifier; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Integer; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Keyword; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::LeftBrace; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::LeftParen; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Period; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::Real; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::RightBrace; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::RightParen; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::SemiColon; + +use strict; +use base 'Varnish::Test::Token'; + +package Varnish::Test::Token::String; + +use strict; +use base 'Varnish::Test::Token'; + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Tokenizer.pm b/varnish-tools/regress/lib/Varnish/Test/Tokenizer.pm new file mode 100644 index 00000000..f18da7f4 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Tokenizer.pm @@ -0,0 +1,185 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +package Varnish::Test::Tokenizer; + +use strict; +use Varnish::Test::Token; + +sub new($$) { + my $this = shift; + my $class = ref($this) || $this; + + my $self = {}; + bless($self, $class); + $self->tokenize($_[0]) + if (@_); + + return $self; +} + +sub tokenize($$) { + my $self = shift; + my $fn = shift; + + local *FILE; + local $/; + + $self->{'fn'} = $fn; + $self->{'tokens'} = (); + + open(FILE, "<", $self->{'fn'}) + or die("$self->{'fn'}: $!\n"); + my $spec = ; + close(FILE); + + # tokenize + my @tokens = (); + for (;;) { + my $type = undef; + if ($spec =~ m/\G\s*$/gc) { + # EOF + push(@tokens, Varnish::Test::Token::EOF->new(pos($spec))); + last; + } elsif ($spec =~ m/\G\s*(\*\/\*([^\*]|\*[^\/])+\*\/)/gc) { + # multiline comment + } elsif ($spec =~ m/\G\s*((?:\/\/|\#).*?)\n/gc) { + # single-line comment + } elsif ($spec =~ m/\G\s*\b(\d+\.\d+)\b/gc) { + # real literal + push(@tokens, Varnish::Test::Token::Real->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*\b(\d+)\b/gc) { + # integer literal + push(@tokens, Varnish::Test::Token::Integer->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*\"((?:\\.|[^\"])*)\"/gc) { + # string literal + push(@tokens, Varnish::Test::Token::String->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*\b(accelerator|client|init|server|case|test|ticket)\b/gc) { + # keyword + push(@tokens, Varnish::Test::Token::Keyword->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*\b(\w+)\b/gc) { + # identifier + push(@tokens, Varnish::Test::Token::Identifier->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\{)/gc) { + # opening brace + push(@tokens, Varnish::Test::Token::LeftBrace->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\})/gc) { + # closing brace + push(@tokens, Varnish::Test::Token::RightBrace->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\()/gc) { + # opening paren + push(@tokens, Varnish::Test::Token::LeftParen->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\))/gc) { + # closing paren + push(@tokens, Varnish::Test::Token::RightParen->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\;)/gc) { + # semicolon + push(@tokens, Varnish::Test::Token::SemiColon->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\.)/gc) { + # period + push(@tokens, Varnish::Test::Token::Period->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*(\,)/gc) { + # comma + push(@tokens, Varnish::Test::Token::Comma->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*([\<\>\=\!]=)/gc) { + # comparison operator + push(@tokens, Varnish::Test::Token::Compare->new(pos($spec), $1)); + } elsif ($spec =~ m/\G\s*([\+\-\*\/]?=)/gc) { + # assignment operator + push(@tokens, Varnish::Test::Token::Assign->new(pos($spec), $1)); +# } elsif ($spec =~ m/\G\s*([\+\-\*\/])/gc) { +# # arithmetic operator +# push(@tokens, Varnish::Test::Token::ArOp->new(pos($spec), $1)); + } else { + die "$self->{'fn'}: syntax error\n" . substr($spec, pos($spec)) . "\n"; + } + } + + $self->{'tokens'} = \@tokens; + return @tokens; +} + +sub die($$) { + my $self = shift; + my $msg = shift; + + CORE::die("$self->{'fn'}: $msg\n"); +} + +sub warn($$) { + my $self = shift; + my $msg = shift; + + CORE::warn("$self->{'fn'}: $msg\n"); +} + + +# Return the next token from the input queue, but do not remove it +# from the queue. Fatal if the queue is empty. +sub peek($) { + my $self = shift; + + $self->die("premature end of input") + unless @{$self->{'tokens'}}; + return $self->{'tokens'}->[0]; +} + +# Remove the next token from the input queue and return it. +# Additional (optional) arguments are token types which the next token +# must match. Fatal if the queue is empty, or arguments were provided +# but none matched. +sub shift($;@) { + my $self = CORE::shift; + my @expect = @_; + + $self->die("premature end of input") + unless @{$self->{'tokens'}}; + my $token = shift @{$self->{'tokens'}}; + if (@expect) { + return $token + if grep({ $token->is($_) } @expect); + $self->die("expected " . join(", ", @expect) . ", got " . $token->type); + } + return $token; +} + +# As shift(), but next token must be a keyword and the arguments are +# matched against the token's value rather than its type. +sub shift_keyword($@) { + my $self = CORE::shift; + my @expect = @_; + + my $token = $self->shift("Keyword"); + return $token + if grep({ $token->value eq $_ } @expect); + $self->die("expected " . join(", ", @expect) . ", got " . $token->value); +} + +1; diff --git a/varnish-tools/regress/test1 b/varnish-tools/regress/test1 new file mode 100644 index 00000000..7c6935e1 --- /dev/null +++ b/varnish-tools/regress/test1 @@ -0,0 +1,51 @@ +test "Preserve HTTP protocol version in PASS mode" { + ticket 56; + + client c1 { + } + + server s1 { + data = "This is a test."; + } + + accelerator a1 { + backend = s1; + vcl = " +sub vcl_recv { + pass; +} +"; + } + + case c10_s10 { + comment = "client 1.0, server 1.0"; + c1.protocol = "1.0"; + s1.protocol = "1.0"; + 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"); + } +} diff --git a/varnish-tools/regress/varnish-regress.pl b/varnish-tools/regress/varnish-regress.pl new file mode 100755 index 00000000..ff53eb75 --- /dev/null +++ b/varnish-tools/regress/varnish-regress.pl @@ -0,0 +1,39 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2006 Linpro AS +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer +# in this position and unchanged. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# $Id$ +# + +use strict; +use lib './lib'; +use Varnish::Test; +use Data::Dumper; + +MAIN:{ + my $test = Varnish::Test->new($ARGV[0]); + #print STDERR Dumper($test); +}