From ada3f1f30f9ccd8dc2a5667c0dfca5b83ebc5365 Mon Sep 17 00:00:00 2001 From: knutroy Date: Tue, 6 Feb 2007 21:55:03 +0000 Subject: [PATCH] Updated regression test framework, but more work is still needed. git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1241 d4fa192b-c00b-0410-8231-f00ffab90ce4 --- varnish-tools/regress/lib/Varnish/Test.pm | 105 +++++----- .../regress/lib/Varnish/Test/Case.pm | 8 + .../regress/lib/Varnish/Test/Client.pm | 59 +++++- .../regress/lib/Varnish/Test/Context.pm | 41 +++- .../regress/lib/Varnish/Test/Expression.pm | 124 ++++++++++++ .../regress/lib/Varnish/Test/Invocation.pm | 69 +++++++ .../regress/lib/Varnish/Test/Message.pm | 36 ++++ .../regress/lib/Varnish/Test/Object.pm | 68 ++++--- .../regress/lib/Varnish/Test/Parser.pm | 133 +++++++++++++ .../regress/lib/Varnish/Test/Reference.pm | 105 ++++++++++ .../regress/lib/Varnish/Test/Request.pm | 2 +- .../regress/lib/Varnish/Test/Response.pm | 2 +- .../regress/lib/Varnish/Test/Server.pm | 52 ++++- .../Varnish/Test/{Code.pm => Statement.pm} | 43 ++-- .../regress/lib/Varnish/Test/Token.pm | 168 ---------------- .../regress/lib/Varnish/Test/Tokenizer.pm | 185 ------------------ varnish-tools/regress/test1 | 29 +-- varnish-tools/regress/varnish-regress.pl | 3 +- 18 files changed, 733 insertions(+), 499 deletions(-) create mode 100644 varnish-tools/regress/lib/Varnish/Test/Expression.pm create mode 100644 varnish-tools/regress/lib/Varnish/Test/Invocation.pm create mode 100644 varnish-tools/regress/lib/Varnish/Test/Message.pm create mode 100644 varnish-tools/regress/lib/Varnish/Test/Parser.pm create mode 100644 varnish-tools/regress/lib/Varnish/Test/Reference.pm rename varnish-tools/regress/lib/Varnish/Test/{Code.pm => Statement.pm} (74%) delete mode 100644 varnish-tools/regress/lib/Varnish/Test/Token.pm delete mode 100644 varnish-tools/regress/lib/Varnish/Test/Tokenizer.pm diff --git a/varnish-tools/regress/lib/Varnish/Test.pm b/varnish-tools/regress/lib/Varnish/Test.pm index 2a6681ca..680d56de 100644 --- a/varnish-tools/regress/lib/Varnish/Test.pm +++ b/varnish-tools/regress/lib/Varnish/Test.pm @@ -31,84 +31,89 @@ package Varnish::Test; use strict; -use base 'Varnish::Test::Context'; +use base 'Varnish::Test::Object'; use Varnish::Test::Accelerator; use Varnish::Test::Case; use Varnish::Test::Client; use Varnish::Test::Server; -use Varnish::Test::Tokenizer; +use Varnish::Test::Parser; +use IO::Multiplex; + +use Data::Dumper; sub new($;$) { my $this = shift; my $class = ref($this) || $this; + my $fn = shift; - my $self = Varnish::Test::Context->new(); + my $self = new Varnish::Test::Object; bless($self, $class); - $self->parse($_[0]) - if (@_); + + $self->{'mux'} = new IO::Multiplex; + + if ($fn) { + $self->parse($fn); + } return $self; } -sub _parse_ticket($$) { +sub parse($$) { my $self = shift; - my $t = shift; + my $fn = shift; - $t->shift_keyword("ticket"); - push(@{$self->{'ticket'}}, $t->shift("Integer")); - $t->shift("SemiColon"); -} + local $/; + open(SRC, "<", $fn) or die("$fn: $!\n"); + my $src = ; + close(SRC); -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); + $::RD_HINT = 1; + my $parser = new Varnish::Test::Parser; + if (!defined($parser)) { + die("Error generating parser."); + } + my $tree = $parser->module($src); + if (!defined($tree)) { + die("Parsing error."); + } + + print "###### SYNTAX TREE BEGIN ######\n"; + print Dumper $tree if defined($tree->{'body'}); + print "###### SYNTAX TREE END ######\n"; + + $self->{'objects'} = []; + + foreach my $object (@{$tree->{'body'}}) { + if (ref($object) eq 'ARRAY') { + $self->{$$object[0]} = $$object[1]; + } + elsif (ref($object)) { + push(@{$self->{'children'}}, $object); + $object->set_parent($self); } } - $token = $t->shift("RightBrace"); } -sub parse($$) { +sub main($) { my $self = shift; - my $fn = shift; - my $t = Varnish::Test::Tokenizer->new($fn); - $self->_parse_test($t); + while (!$self->{'finished'}) { + &Varnish::Test::Object::run($self); + print "Entering IO::Multiplex loop.\n"; + $self->{'mux'}->loop; + } + + print "DONE.\n"; } sub run($) { my $self = shift; + return if $self->{'finished'}; + + &Varnish::Test::Object::run($self); + + $self->shutdown if $self->{'finished'}; } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case.pm b/varnish-tools/regress/lib/Varnish/Test/Case.pm index 336fa457..9c5f5df5 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case.pm @@ -33,4 +33,12 @@ package Varnish::Test::Case; use strict; use base 'Varnish::Test::Object'; +sub run($) { + my $self = shift; + + print "Running case \"$self->{name}\"...\n"; + + &Varnish::Test::Object::run($self); +} + 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Client.pm b/varnish-tools/regress/lib/Varnish/Test/Client.pm index 5c097c88..9b4d0de4 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Client.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Client.pm @@ -35,21 +35,64 @@ use base 'Varnish::Test::Object'; use IO::Socket; use URI; -sub request($$$) { +sub _init($) { my $self = shift; - my $server = shift; - my $url = shift; + + $self->set('protocol', '1.1'); + $self->set('request', \&request); +} + +sub request($$) { + my $self = shift; + my $invocation = shift; + + my $server = $invocation->{'args'}[0]->{'return'}; + my $uri = $invocation->{'args'}[1]->{'return'}; (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 + $uri = new URI($uri) + or die("invalid URI\n"); + + my $fh = new IO::Socket::INET(Proto => 'tcp', + PeerAddr => $server->get('address'), + PeerPort => $server->get('port')) + or die "socket: $@"; + + my $mux = $self->get_mux; + $mux->add($fh); + $mux->set_callback_object($self, $fh); + + $mux->write($fh, "Hello\r\n"); + print "Client sent: Hello\n"; + + $self->{'request'} = $invocation; +} + +sub mux_input($$$$) { + my $self = shift; + my $mux = shift; + my $fh = shift; + my $data = shift; + + $self->{'request'}->{'return'} = $$data; + print "Client got: $$data"; + $$data = ""; + $self->{'request'}->{'finished'} = 1; + delete $self->{'request'}; + $self->super_run; +} + +sub mux_eof($$$$) { + my $self = shift; + my $mux = shift; + my $fh = shift; + my $data = shift; + + $mux->close($fh); } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Context.pm b/varnish-tools/regress/lib/Varnish/Test/Context.pm index 3692d3d8..9c02d4c7 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Context.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Context.pm @@ -38,37 +38,51 @@ use strict; # parent, from which it inherits variables and procedures. # -sub new($;$) { +sub new($$;$) { my $this = shift; my $class = ref($this) || $this; + my $name = shift; my $parent = shift; my $self = { - 'parent' => $parent, + 'name' => $name, 'vars' => { }, - 'procs' => { }, }; bless($self, $class); + $self->set_parent($parent); + return $self; } -sub parent($) { +sub set_parent($$) { my $self = shift; + my $parent = shift; - return $self->{'parent'}; + if (defined($self->{'name'})) { + if (defined($self->{'parent'})) { + # Unlink from old parent. + $self->{'parent'}->unset($self->{'name'}); + } + if (defined($parent)) { + # Link to new parent. + $parent->set($self->{'name'}, $self); + } + } + + $self->{'parent'} = $parent; } -sub vars($) { +sub parent($) { my $self = shift; - return $self->{'vars'}; + return $self->{'parent'}; } -sub procs($) { +sub vars($) { my $self = shift; - return $self->{'procs'}; + return $self->{'vars'}; } sub set($$$) { @@ -85,12 +99,19 @@ sub set($$$) { return $value; } +sub unset($$) { + my $self = shift; + my $key = shift; + + delete $self->vars->{$key} if exists($self->vars->{$key}); +} + sub has($$) { my $self = shift; my $key = shift; return exists($self->{'vars'}->{$key}) || - $self->parent->has($key); + $self->parent && $self->parent->has($key); } sub get($$) { diff --git a/varnish-tools/regress/lib/Varnish/Test/Expression.pm b/varnish-tools/regress/lib/Varnish/Test/Expression.pm new file mode 100644 index 00000000..4296ac9c --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Expression.pm @@ -0,0 +1,124 @@ +#!/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::Expression; + +use strict; +use base 'Varnish::Test::Object'; +use Varnish::Test::Invocation; + +sub new($$;$) { + my $this = shift; + my $class = ref($this) || $this; + my $terms = shift; + my $force_create = shift; + + if (@$terms == 1 && (!$force_create || ref($$terms[0]) eq $class)) { + return $$terms[0]; + } + + my $children = []; + + if (@$terms == 2 + && ref($$terms[0]) eq 'Varnish::Test::Reference' + && ref($$terms[1]) eq 'ARRAY') { + my $invocation = new Varnish::Test::Invocation($$terms[0], $$terms[1]); + push (@$children, $invocation); + undef $terms; + } + else { + foreach my $term (@$terms) { + push (@$children, $term) if ref($term) eq 'Varnish::Test::Expression'; + } + } + + my $self = new Varnish::Test::Object(undef, $children); + bless($self, $class); + $self->{'terms'} = $terms; + + return $self; +} + +sub run($) { + my $self = shift; + + return if $self->{'finished'}; + + &Varnish::Test::Object::run($self); + + if ($self->{'finished'} && defined($self->{'terms'})) { + my $expr = ''; + my $return_as_string = 0; + + foreach my $term (@{$self->{'terms'}}) { + my $term_value; + if (ref($term) eq 'Varnish::Test::Expression') { + $term_value = $term->{'return'}; + } + elsif (ref($term) eq 'Varnish::Test::Reference') { + $term_value = $term->get_value($self); + if (!defined($term_value)) { + die '"' . $term->as_string . '"' . " not defined"; + } + } + else { + $term_value = $term; + } + + if (ref(\$term_value) eq 'REF') { + if (@{$self->{'terms'}} == 1) { + $self->{'return'} = $term_value; + return; + } + else { + die "Found object/context reference in complex expression."; + } + } + + if ($term_value =~ /^".*"$/s) { + $return_as_string = 1; + } + + $expr .= $term_value; + } + + ($expr) = $expr =~ /(.*)/s; + + $expr = eval $expr; + + if ($return_as_string) { + $expr = '"' . $expr . '"'; + } + + $self->{'return'} = $expr; + } +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Invocation.pm b/varnish-tools/regress/lib/Varnish/Test/Invocation.pm new file mode 100644 index 00000000..450c4fd2 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Invocation.pm @@ -0,0 +1,69 @@ +#!/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::Invocation; + +use strict; +use base 'Varnish::Test::Object'; + +sub new($$$) { + my $this = shift; + my $class = ref($this) || $this; + my $func_id = shift; + my $args = shift; + + my $self = new Varnish::Test::Object(undef, $args); + bless($self, $class); + + $self->{'func_id'} = $func_id; + $self->{'args'} = $args; + + return $self; +} + +sub run($) { + my $self = shift; + + return if $self->{'finished'}; + + &Varnish::Test::Object::run($self) unless $self->{'in_call'}; + + if ($self->{'finished'}) { + $self->{'finished'} = 0; + 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"; + &$func_ptr($func_context, $self); + } + } +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Message.pm b/varnish-tools/regress/lib/Varnish/Test/Message.pm new file mode 100644 index 00000000..ad58e722 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Message.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::Message; + +use strict; +use base 'Varnish::Test::Object'; + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Object.pm b/varnish-tools/regress/lib/Varnish/Test/Object.pm index 0b147526..5c1a8124 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Object.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Object.pm @@ -32,51 +32,67 @@ package Varnish::Test::Object; use strict; use base 'Varnish::Test::Context'; -use Varnish::Test::Code; -sub new($$;$) { +sub new($$$;$) { my $this = shift; my $class = ref($this) || $this; + my $name = shift; + my $children = shift; my $parent = shift; - my $self = Varnish::Test::Context->new($parent); - $self->{'code'} = []; + my $self = new Varnish::Test::Context($name, $parent); bless($self, $class); - $self->_init(); + for my $child (@$children) { + $child->set_parent($self); + } - $self->_parse($_[0]) - if (@_); + $self->{'children'} = $children; + $self->{'finished'} = 0; + $self->{'return'} = undef; + $self->_init; return $self; } sub _init($) { +} + +sub run($) { my $self = shift; - # nothing + return if $self->{'finished'}; + + foreach my $child (@{$self->{'children'}}) { + $child->run($self) unless $child->{'finished'}; + return unless $child->{'finished'}; + $self->{'return'} = $child->{'return'}; + } + + $self->{'finished'} = 1; } -sub _parse($$) { +sub shutdown($) { 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); + + foreach my $child (@{$self->{'children'}}) { + $child->shutdown; + } +} + +sub get_mux($) { + my $self = shift; + return $self->{'mux'} || $self->{'parent'} && $self->{'parent'}->get_mux; +} + +sub super_run($) { + my $self = shift; + if (defined($self->{'parent'})) { + $self->{'parent'}->super_run; + } + else { + $self->run; } - $t->shift("RightBrace"); } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Parser.pm b/varnish-tools/regress/lib/Varnish/Test/Parser.pm new file mode 100644 index 00000000..f2f21dcb --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Parser.pm @@ -0,0 +1,133 @@ +#!/usr/bin/perl -Tw +#- +# Copyright (c) 2007 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::Parser; + +use strict; + +use Parse::RecDescent; +use Varnish::Test::Reference; +use Varnish::Test::Expression; +use Varnish::Test::Statement; +use Varnish::Test::Client; +use Varnish::Test::Server; +use Varnish::Test::Accelerator; +use Varnish::Test::Case; + +sub new { + return new Parse::RecDescent(<<'EOG'); + +STRING_LITERAL: + { extract_delimited($text, '"') } + +IDENTIFIER: + /[a-z]\w*/i + +CONSTANT: + /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/ + +reference: + + { new Varnish::Test::Reference($item[1]) } + +argument_list: + + +call: + reference '(' argument_list(?) ')' + { new Varnish::Test::Expression([$item[1], (@{$item[3]}) ? $item[3][0] : []]) } + | + +primary_expression: + call + | reference + | STRING_LITERAL + | CONSTANT + | '(' expression ')' + { $item[2] } + +mul_op: + '*' | '/' | '%' + +multiplicative_expression: + + { new Varnish::Test::Expression($item[1]) } + +add_op: + '+' | '-' | '.' + +additive_expression: + + { new Varnish::Test::Expression($item[1]) } + +rel_op: + '==' | '!=' | '<=' | '>=' | '<' | '>' + +expression: + additive_expression rel_op additive_expression + { new Varnish::Test::Expression([@item[1..$#item]], 1) } + | additive_expression + { new Varnish::Test::Expression([$item[1]], 1) } + | + +statement: + reference '=' expression + { new Varnish::Test::Statement([@item[1..3]]) } + | call + { new Varnish::Test::Statement([$item[1]]) } + +block: + '{' statement(s? /;/) (';')(?) '}' + { $item[2] } + | + +object: + 'ticket' CONSTANT ';' + { [@item[1,2]] } + | 'client' IDENTIFIER block + { new Varnish::Test::Client(@item[2,3]) } + | 'server' IDENTIFIER block + { new Varnish::Test::Server(@item[2,3]) } + | 'accelerator' IDENTIFIER block + { new Varnish::Test::Accelerator(@item[2,3]) } + | 'case' IDENTIFIER block + { new Varnish::Test::Case(@item[2,3]) } + | + +module: + 'test' STRING_LITERAL(?) '{' object(s?) '}' /^\Z/ + { { 'id' => (@{$item[2]}) ? $item[2][0] : undef, + 'body' => $item[4] } } + | + +EOG +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Reference.pm b/varnish-tools/regress/lib/Varnish/Test/Reference.pm new file mode 100644 index 00000000..29f20bd1 --- /dev/null +++ b/varnish-tools/regress/lib/Varnish/Test/Reference.pm @@ -0,0 +1,105 @@ +#!/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::Reference; + +use strict; + +sub new($$) { + my $this = shift; + my $class = ref($this) || $this; + my $symbols = shift; + + my $self = { + 'symbols' => $symbols, + }; + bless($self, $class); + + return $self; +} + +sub as_string($) { + my $self = shift; + return join('.', @{$self->{'symbols'}}); +} + +sub _find_context($$) { + my $self = shift; + my $context = shift; + + foreach my $symbol (@{$self->{'symbols'}}[0..$#{$self->{'symbols'}}-1]) { + $context = $context->get($symbol); + if (!(ref($context) =~ /^Varnish::Test::\w+$/ + && $context->isa('Varnish::Test::Context'))) { + return undef; + } + } + + return $context; +} + +sub get_value($$) { + my $self = shift; + my $context = shift; + + $context = $self->_find_context($context); + if (defined($context)) { + return $context->get($self->{'symbols'}[$#{$self->{'symbols'}}]); + } + else { + return undef; + } +} + +sub set_value($$) { + my $self = shift; + my $context = shift; + my $value = shift; + + $context = $self->_find_context($context); + if (defined($context)) { + $context->set($self->{'symbols'}[$#{$self->{'symbols'}}], $value); + } + else { + die "Cannot find containing context for ", join('.', @{$self->{'symbols'}}), ".\n"; + } +} + +sub get_function($$) { + my $self = shift; + my $context = shift; + + $context = $self->_find_context($context); + if (defined($context)) { + return ($context->get($self->{'symbols'}[$#{$self->{'symbols'}}]), $context); + } +} + +1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Request.pm b/varnish-tools/regress/lib/Varnish/Test/Request.pm index 8d304fba..d872dc3b 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Request.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Request.pm @@ -31,6 +31,6 @@ package Varnish::Test::Request; use strict; -use base 'Varnish::Test::Object'; +use base 'Varnish::Test::Message'; 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Response.pm b/varnish-tools/regress/lib/Varnish/Test/Response.pm index 819319ca..60f72ada 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Response.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Response.pm @@ -31,6 +31,6 @@ package Varnish::Test::Response; use strict; -use base 'Varnish::Test::Object'; +use base 'Varnish::Test::Message'; 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Server.pm b/varnish-tools/regress/lib/Varnish/Test/Server.pm index 3512bf4d..28a98a01 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Server.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Server.pm @@ -32,12 +32,60 @@ package Varnish::Test::Server; use strict; use base 'Varnish::Test::Object'; +use IO::Socket; sub _init($) { my $self = shift; - $self->vars->{'address'} = 'localhost'; - $self->vars->{'port'} = '9001'; + $self->set('address', 'localhost'); + $self->set('port', '9001'); +} + +sub run($) { + my $self = shift; + + return if $self->{'finished'}; + + &Varnish::Test::Object::run($self); + + my $fh = new IO::Socket::INET(Proto => 'tcp', + LocalAddr => $self->get('address'), + LocalPort => $self->get('port'), + Listen => 4) + or die "socket: $@"; + + $self->{'fh'} = $fh; + + my $mux = $self->get_mux; + $mux->listen($fh); + $mux->set_callback_object($self, $fh); +} + +sub shutdown($) { + my $self = shift; + + $self->get_mux->close($self->{'fh'}); +} + +sub mux_connection($$$) { + my $self = shift; + my $mux = shift; + my $fh = shift; + + $mux->set_callback_object($self, $fh); +} + +sub mux_input($$$$) { + my $self = shift; + my $mux = shift; + 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"; + $mux->shutdown($fh, 1); } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Code.pm b/varnish-tools/regress/lib/Varnish/Test/Statement.pm similarity index 74% rename from varnish-tools/regress/lib/Varnish/Test/Code.pm rename to varnish-tools/regress/lib/Varnish/Test/Statement.pm index 7a6e45b4..8d3976a5 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Code.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Statement.pm @@ -28,40 +28,41 @@ # $Id$ # -package Varnish::Test::Code; +package Varnish::Test::Statement; use strict; +use base 'Varnish::Test::Object'; -sub new($$$) { +sub new($$) { my $this = shift; my $class = ref($this) || $this; - my $context = shift; + my $args = shift; - my $self = { - 'context' => $context, - }; - bless($self, $class); + my $children = []; - $self->_parse(shift) - if (@_); + if (@$args > 1 && $$args[1] eq '=') { + my $self = new Varnish::Test::Object(undef, [$$args[2]]); + bless($self, $class); - return $self; + $self->{'lhs'} = $$args[0]; + + return $self; + } + else { + return $$args[0]; + } } -sub _parse($$) { +sub run($$) { 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"; -} + return if $self->{'finished'}; + + &Varnish::Test::Object::run($self); -sub run($) { + if ($self->{'finished'}) { + $self->{'lhs'}->set_value($self, $self->{'return'}); + } } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Token.pm b/varnish-tools/regress/lib/Varnish/Test/Token.pm deleted file mode 100644 index a40bea54..00000000 --- a/varnish-tools/regress/lib/Varnish/Test/Token.pm +++ /dev/null @@ -1,168 +0,0 @@ -#!/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 deleted file mode 100644 index f18da7f4..00000000 --- a/varnish-tools/regress/lib/Varnish/Test/Tokenizer.pm +++ /dev/null @@ -1,185 +0,0 @@ -#!/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 index 7c6935e1..00470286 100644 --- a/varnish-tools/regress/test1 +++ b/varnish-tools/regress/test1 @@ -21,31 +21,8 @@ sub vcl_recv { 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"); + c1.request(s1, "http://www.example.com/"); + c1.request(s1, "http://www.example.com/"); + c1.request(s1, "http://www.example.com/"); } } diff --git a/varnish-tools/regress/varnish-regress.pl b/varnish-tools/regress/varnish-regress.pl index ff53eb75..c82d2495 100755 --- a/varnish-tools/regress/varnish-regress.pl +++ b/varnish-tools/regress/varnish-regress.pl @@ -34,6 +34,7 @@ use Varnish::Test; use Data::Dumper; MAIN:{ - my $test = Varnish::Test->new($ARGV[0]); + my $test = new Varnish::Test($ARGV[0]); #print STDERR Dumper($test); + $test->main; } -- 2.39.5