use Carp 'croak';
use Varnish::Test::Engine;
-use Varnish::Test::Case::LoadVCL;
-use Varnish::Test::Case::StartChild;
-use Varnish::Test::Case::StopChild;
sub new($) {
my ($this) = @_;
my ($self, @args) = @_;
return if defined $self->{'engine'};
- $self->{'engine'} = Varnish::Test::Engine->new(@args);
+ $self->{'engine'} = Varnish::Test::Engine->new(@args);
$self->{'engine'}->run_loop;
}
push(@{$self->{'cases'}}, $case);
- Varnish::Test::Case::LoadVCL->new($self->{'engine'})->run($case->vcl)
- if $case->can('vcl');
-
- Varnish::Test::Case::StartChild->new($self->{'engine'})->run;
-
+ $case->init;
$case->run;
-
- Varnish::Test::Case::StopChild->new($self->{'engine'})->run;
+ $case->fini;
$self->stop_engine;
}
$self->{'engine'}->log($self, 'CAS: ', $str);
}
-sub run($;@) {
- my ($self, @args) = @_;
+sub init($) {
+ my ($self) = @_;
$self->{'engine'}->{'case'} = $self;
+ my $varnish = $self->{'engine'}->{'varnish'};
+
+ # Load VCL script if we have one
+ no strict 'refs';
+ if (${ref($self)."::VCL"}) {
+ my $vcl = $varnish->backend_block('main') . ${ref($self)."::VCL"};
+
+ $varnish->send_vcl(ref($self), $vcl);
+ $self->run_loop();
+ $varnish->use_vcl(ref($self));
+ $self->run_loop();
+ }
+
+ # Start the child
+ $varnish->start_child();
+ $self->run_loop();
+}
+
+sub fini($) {
+ my ($self) = @_;
+
+ my $varnish = $self->{'engine'}->{'varnish'};
+
+ # Stop the worker process
+ $varnish->stop_child();
+ $self->run_loop();
+
+ # Revert to initial VCL script
+ no strict 'refs';
+ if (${ref($self)."::VCL"}) {
+ $varnish->use_vcl('boot');
+ $self->run_loop();
+ }
+
+ delete $self->{'engine'}->{'case'};
+}
+
+sub run($;@) {
+ my ($self, @args) = @_;
+
$self->log('Starting ' . ref($self));
no strict 'refs';
- foreach my $method (keys %{ref($self) . '::'}) {
- next unless $method =~ m/^test([A-Z]\w+)/;
+ my @tests = @{ref($self)."::TESTS"};
+ if (!@tests) {
+ @tests = sort grep {/^test(\w+)/} (keys %{ref($self) . '::'});
+ }
+ foreach my $method (@tests) {
eval {
$self->{'count'} += 1;
my $result = $self->$method(@args);
$self->{'count'}, $method, $@));
}
}
-
- delete $self->{'engine'}->{'case'};
}
sub run_loop($) {
return Varnish::Test::Client->new($self->{'engine'});
}
+sub ev_varnish_command_ok($) {
+ my ($self) = @_;
+
+ $self->pause_loop;
+}
+
sub ev_client_response($$$) {
my ($self, $client, $response) = @_;
+++ /dev/null
-#!/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::LoadVCL;
-
-use strict;
-use base 'Varnish::Test::Case';
-
-use Carp 'croak';
-
-sub testLoadVCL($$) {
- my ($self, $vcl) = @_;
-
- $self->{'engine'}->{'varnish'}->send_vcl('main', $vcl);
- $self->run_loop;
-
- $self->{'engine'}->{'varnish'}->send_command('vcl.use main');
- $self->run_loop;
-}
-
-sub ev_varnish_command_ok($) {
- my ($self) = @_;
-
- $self->pause_loop;
-}
-
-1;
+++ /dev/null
-#!/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::StartChild;
-
-use strict;
-use base 'Varnish::Test::Case';
-
-use Carp 'croak';
-
-sub testStartChild($$) {
- my ($self, $vcl) = @_;
-
- $self->{'engine'}->{'varnish'}->start_child;
- croak 'Inappropriate event' if $self->run_loop ne 'Started';
- return 'OK';
-}
-
-sub ev_varnish_child_started($) {
- my ($self) = @_;
-
- $self->pause_loop('Started');
-}
-
-1;
+++ /dev/null
-#!/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::StopChild;
-
-use strict;
-use base 'Varnish::Test::Case';
-
-use Carp 'croak';
-
-sub testStopChild($$) {
- my ($self, $vcl) = @_;
-
- $self->{'engine'}->{'varnish'}->stop_child;
- croak 'Inappropriate event' if $self->run_loop ne 'Stopped';
- return 'OK';
-}
-
-sub ev_varnish_child_stopped($) {
- my ($self) = @_;
-
- $self->pause_loop('Stopped');
-}
-
-1;
use Carp 'croak';
+our $VCL = "
+sub vcl_recv {
+ pass;
+}
+";
+
sub testVersionMatch($) {
my ($self) = @_;
$connection->shutdown;
}
-sub vcl($) {
- my ($self) = @_;
-
- return $self->{'engine'}->{'varnish'}->backend_block('main') . <<'EOVCL'
-sub vcl_recv {
- pass;
-}
-EOVCL
-}
-
1;
use Carp 'croak';
+our $VCL = <<EOVCL;
+sub vcl_recv {
+ if (req.request == "POST" &&
+ (!req.http.content-length || req.http.content-length == "0")) {
+ lookup;
+ }
+}
+EOVCL
+
our $body = "Hello World!\n";
sub testBodyInCachedPOST($) {
$connection->send_response($response);
}
-sub vcl($) {
- my ($self) = @_;
-
- return $self->{'engine'}->{'varnish'}->backend_block('main') . <<'EOVCL'
-sub vcl_recv {
- if (req.request == "POST" &&
- (!req.http.content-length || req.http.content-length == "0")) {
- lookup;
- }
-}
-EOVCL
-}
-
1;