@@ -1,5 +1,110 @@
Changes for Test::Nginx
+0.24 - 2014-12-07
+ * feature: added support for the "benchmark" testing mode enabled
+ by the TEST_NGINX_BENCHMARK environment variable.
+
+ * feature: added support for the TEST_NGINX_BENCHMARK_WARMUP
+ environment to specify the number of warm-up requests before the
+ actual benchmark testing.
+
+ * feature: added support for the "--- curl" section that generates
+ a "curl" command line for the corresponding test request.
+
+ * feature: added new section "--- server_name" to control the
+ value of the server_name nginx config directive used for the
+ default server {}.
+
+ * feature: added new section "--- error_log_file".
+
+ * feature: automatically print out warnings for [emerg] messages
+ in nginx's error.log to stderr if it is not mentioned in "---
+ error_log" nor "--- no_error_log".
+
+ * feature: Test::Nginx::Socket: "--- request" now supports leading
+ comment lines prefixed by "#".
+
+ * feature: the "--- user_files" section supports raw Perl data
+ structures for specifying the user files.
+
+ * feature: the "--- more_headers" section now supports perl
+ array-ref typed values for pipelined requests.
+
+ * feature: exported the "add_response_body_check" and "is_str"
+ utility functions.
+
+ * feature: the "--- udp_reply" section now accepts a Perl
+ subroutine as its value which can be used to generate dynamic
+ replies based on the actual query. thanks blablacio for the
+ original patch.
+
+ * feature: Test::Nginx::Socket: exported new Perl utility
+ functions "add_cleanup_handler", "add_block_preprocessor", and
+ "bail_out".
+
+ * feature: made the special $LIBxxx_PATH variable more general in
+ the "--- stap" section.
+
+ * feature: the "--- no_error_log" section now tries to find all
+ the matched lines in error logs instead of stopping on the first
+ hit.
+
+ * feature: added new section "--- tcp_shutdown" for shutting down
+ read, write, or both parts of the connection in the embedded TCP
+ server immedately after the connection is established.
+
+ * feature: the value of "--- tcp_query_len" now defaults to the
+ lenghth of the value of "--- tcp_query" (if any).
+
+ * feature: added new section "--- must_die" for testing the cases
+ that nginx fail to start (like invalid nginx configurations and
+ etc). thanks Markus Linnala for the patch.
+
+ * bugfix: when user specifies "Host" and "Connection" in "---
+ more_headers", then we should not add our own Host request
+ headers.
+
+ * bugfix: made the default value of the "Connection" request
+ header to be "close" instead of "Close".
+
+ * bugfix: the "check leak" testing mode might send a bogus request
+ header via ab or weighttp.
+
+ * bugfix: we should also wait for the time specified by the "---
+ abort" section before checking error logs for the repeated
+ requests that are not the last one.
+
+ * optimize disabled accept_mutex by default in the auto-generated
+ nginx.conf.
+
+ * bugfix: "--- skip_nginx" and "--- skip_nginx2" did not skip
+ tests related to the mocked TCP and UDP servers.
+
+ * bugfix: we did not automatically remove the .stp and .stp-out
+ temp files created by the "--- stap" sections in the systemtap
+ testing mode.
+
+ * bugfix: "--- request" did not provide the guilty request line
+ that it failed to parse.
+
+ * bugfix: Test::Nginx::Socket: "--- error_code" might take bad
+ values.
+
+ * bugfix: we incorrectly discarded all the query data read in the
+ mocked TCP server when timeout errors happen (due to the actual
+ query is shorter than the expected data specified "---
+ tcp_query", for example).
+
+ * bugfix: the "check leak" testing mode could not parse raw HTTP
+ requests using LF instead of CRLF for line terminators.
+
+ * doc: documented the section "--- init".
+
+ * doc: added info for the openresty and openresty-en mailing lists
+ for discussions.
+
+ * doc: spelling fixes from Markus Linnala.
+
0.23 - 2014-04-05
* feature: added new section --- response_body_unlike. thanks
Rickey Visinski for the patch.
@@ -1,7 +1,7 @@
---
-abstract: 'Testing modules for Nginx C module development'
+abstract: 'Data-driven test scaffold for Nginx C module and OpenResty Lua library development'
author:
- - 'agentzh (章亦春) C<< <agentzh@gmail.com> >>'
+ - 'Yichun Zhang (agentzh) C<< <agentzh@gmail.com> >>'
build_requires:
ExtUtils::MakeMaker: 6.59
configure_requires:
@@ -43,4 +43,4 @@ requires:
resources:
license: http://opensource.org/licenses/bsd-license.php
repository: http://github.com/agentzh/test-nginx
-version: 0.23
+version: 0.24
@@ -1,5 +1,6 @@
NAME
- Test::Nginx - Testing modules for Nginx C module development
+ Test::Nginx - Data-driven test scaffold for Nginx C module and OpenResty
+ Lua library development
DESCRIPTION
This distribution provides two testing modules for Nginx C module
@@ -131,7 +132,7 @@ DESCRIPTION
valgrind integration
Test::Nginx has integrated support for valgrind (<http://valgrind.org>)
even though by default it does not bother running it with the tests
- because valgrind will significantly slow down the test sutie.
+ because valgrind will significantly slow down the test suite.
First ensure that your valgrind executable visible in your PATH env. And
then run your test suite with the "TEST_NGINX_USE_VALGRIND" env set to
@@ -237,15 +238,24 @@ SOURCE REPOSITORY
DEBIAN PACKAGES
António P. P. Almeida is maintaining a Debian package for this module in
- his Debian repository: http://debian.perusio.net
+ his Debian repository: <http://debian.perusio.net>
+
+Community
+ English Mailing List
+ The "openresty-en" mailing list is for English speakers:
+ <https://groups.google.com/group/openresty-en>
+
+ Chinese Mailing List
+ The "openresty" mailing list is for Chinese speakers:
+ <https://groups.google.com/group/openresty>
AUTHORS
- agentzh (章亦春) "<agentzh@gmail.com>"
+ Yichun Zhang (agentzh) "<agentzh@gmail.com>"
Antoine BONAVITA "<antoine.bonavita@gmail.com>"
COPYRIGHT & LICENSE
- Copyright (c) 2009-2012, agentzh "<agentzh@gmail.com>".
+ Copyright (c) 2009-2014, Yichun Zhang (agentzh) "<agentzh@gmail.com>".
Copyright (c) 2011-2012, Antoine Bonavita
"<antoine.bonavita@gmail.com>".
@@ -1,18 +1,10 @@
#line 1
-##
-# name: Spiffy
-# abstract: Spiffy Perl Interface Framework For You
-# author: Ingy döt Net <ingy@ingy.net>
-# license: perl
-# copyright: 2004, 2006, 2011, 2012
-
+use strict; use warnings;
package Spiffy;
-use strict;
-use 5.006001;
-use warnings;
+our $VERSION = '0.46';
+
use Carp;
require Exporter;
-our $VERSION = '0.31';
our @EXPORT = ();
our @EXPORT_BASE = qw(field const stub super);
our @EXPORT_OK = (@EXPORT_BASE, qw(id WWW XXX YYY ZZZ));
@@ -230,7 +222,8 @@ sub field {
my $code = $code{sub_start};
if ($args->{-init}) {
my $fragment = $args->{-weak} ? $code{weak_init} : $code{init};
- $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
+ my @count = ($fragment =~ /(%s)/g);
+ $code .= sprintf $fragment, $field, $args->{-init}, ($field) x (@count - 2);
}
$code .= sprintf $code{set_default}, $field, $default_string, $field
if defined $default;
@@ -540,4 +533,3 @@ sub ZZZ {
}
1;
-
@@ -336,6 +336,4 @@ sub _write_to {
or die "Couldn't close $filename: $!\n";
}
-__DATA__
-
-#line 636
+1;
@@ -1,9 +1,22 @@
#line 1
package Test::Base;
-use 5.006001;
-use Spiffy 0.30 -Base;
+our $VERSION = '0.88';
+
+use Spiffy -Base;
use Spiffy ':XXX';
-our $VERSION = '0.60';
+
+my $HAS_PROVIDER;
+BEGIN {
+ $HAS_PROVIDER = eval "require Test::Builder::Provider; 1";
+
+ if ($HAS_PROVIDER) {
+ Test::Builder::Provider->import('provides');
+ }
+ else {
+ *provides = sub { 1 };
+ }
+}
+
my @test_more_exports;
BEGIN {
@@ -24,9 +37,9 @@ our @EXPORT = (@test_more_exports, qw(
is no_diff
blocks next_block first_block
- delimiters spec_file spec_string
+ delimiters spec_file spec_string
filters filters_delay filter_arguments
- run run_compare run_is run_is_deeply run_like run_unlike
+ run run_compare run_is run_is_deeply run_like run_unlike
skip_all_unless_require is_deep run_is_deep
WWW XXX YYY ZZZ
tie_output no_diag_on_only
@@ -59,7 +72,7 @@ my $default_class;
my $default_object;
my $reserved_section_names = {};
-sub default_object {
+sub default_object {
$default_object ||= $default_class->new;
return $default_object;
}
@@ -67,7 +80,7 @@ sub default_object {
my $import_called = 0;
sub import() {
$import_called = 1;
- my $class = (grep /^-base$/i, @_)
+ my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
@@ -90,7 +103,7 @@ sub import() {
Test::More->import(import => \@test_more_exports, @args)
if @args;
}
-
+
_strict_warnings();
goto &Spiffy::import;
}
@@ -147,14 +160,14 @@ sub blocks() {
if @_ && $_[0] !~ /^[a-zA-Z]\w*$/;
my $blocks = $self->block_list;
-
+
my $section_name = shift || '';
my @blocks = $section_name
? (grep { exists $_->{$section_name} } @$blocks)
: (@$blocks);
return scalar(@blocks) unless wantarray;
-
+
return (@blocks) if $self->_filters_delay;
for my $block (@blocks) {
@@ -225,7 +238,7 @@ sub filters() {
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
- else {
+ else {
my $filters = $self->_filters;
push @$filters, @_;
}
@@ -242,23 +255,24 @@ sub have_text_diff {
$Algorithm::Diff::VERSION >= 1.15;
}
+provides 'is';
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
+ local $Test::Builder::Level = $Test::Builder::Level + 1 unless $HAS_PROVIDER;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
not defined $expected or
- $actual eq $expected or
- not($self->have_text_diff) or
+ $actual eq $expected or
+ not($self->have_text_diff) or
$expected !~ /\n./s
) {
Test::More::is($actual, $expected, $name);
}
else {
$name = '' unless defined $name;
- ok $actual eq $expected,
- $name . "\n" . Text::Diff::diff(\$expected, \$actual);
+ ok $actual eq $expected, $name;
+ diag Text::Diff::diff(\$expected, \$actual);
}
}
@@ -322,7 +336,7 @@ sub run_is() {
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
- is($block->$x, $block->$y,
+ is($block->$x, $block->$y,
$block->name ? $block->name : ()
);
}
@@ -335,7 +349,7 @@ sub run_is_deeply() {
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
- is_deeply($block->$x, $block->$y,
+ is_deeply($block->$x, $block->$y,
$block->name ? $block->name : ()
);
}
@@ -391,7 +405,7 @@ sub run_is_deep() {
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
$block->run_filters unless $block->is_filtered;
- is_deep($block->$x, $block->$y,
+ is_deep($block->$x, $block->$y,
$block->name ? $block->name : ()
);
}
@@ -462,7 +476,7 @@ sub _make_block {
}
$description =~ s/\s*\z//;
$block->set_value(description => $description);
-
+
my $section_map = {};
my $section_order = [];
while (@parts) {
@@ -499,9 +513,9 @@ sub _spec_init {
$spec = <FILE>;
close FILE;
}
- else {
- $spec = do {
- package main;
+ else {
+ $spec = do {
+ package main;
no warnings 'once';
<DATA>;
};
@@ -617,7 +631,7 @@ sub run_filters {
join '', @value;
my $old = $_;
@value = &$function(@value);
- if (not(@value) or
+ if (not(@value) or
@value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/
) {
if ($value[0] && $_ eq $old) {
@@ -650,7 +664,7 @@ sub _get_filters {
$map_filters = [ $map_filters ] unless ref $map_filters;
my @append = ();
for (
- @{$self->blocks_object->_filters},
+ @{$self->blocks_object->_filters},
@$map_filters,
split(/\s+/, $string),
) {
@@ -675,8 +689,4 @@ sub _get_filters {
} keys(%Test::Base::Block::), qw( new DESTROY );
}
-__DATA__
-
-=encoding utf8
-
-#line 1374
+1;
@@ -3,12 +3,12 @@ package Test::Builder::Module;
use strict;
-use Test::Builder;
+use Test::Builder 0.99;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.98';
+our $VERSION = '1.001009';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
@@ -5,7 +5,7 @@ use 5.006;
use strict;
use warnings;
-our $VERSION = '0.98';
+our $VERSION = '1.001009';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
@@ -90,7 +90,21 @@ sub create {
return $self;
}
-#line 168
+
+# Copy an object, currently a shallow.
+# This does *not* bless the destination. This keeps the destructor from
+# firing when we're just storing a copy of the object to restore later.
+sub _copy {
+ my($src, $dest) = @_;
+
+ %$dest = %$src;
+ _share_keys($dest);
+
+ return;
+}
+
+
+#line 182
sub child {
my( $self, $name ) = @_;
@@ -104,15 +118,20 @@ sub child {
# Clear $TODO for the child.
my $orig_TODO = $self->find_TODO(undef, 1, undef);
- my $child = bless {}, ref $self;
- $child->reset;
+ my $class = ref $self;
+ my $child = $class->create;
# Add to our indentation
$child->_indent( $self->_indent . ' ' );
-
- $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
- if ($parent_in_todo) {
- $child->{Fail_FH} = $self->{Todo_FH};
+
+ # Make the child use the same outputs as the parent
+ for my $method (qw(output failure_output todo_output)) {
+ $child->$method( $self->$method );
+ }
+
+ # Ensure the child understands if they're inside a TODO
+ if( $parent_in_todo ) {
+ $child->failure_output( $self->todo_output );
}
# This will be reset in finalize. We do this here lest one child failure
@@ -127,11 +146,11 @@ sub child {
}
-#line 211
+#line 233
sub subtest {
my $self = shift;
- my($name, $subtests) = @_;
+ my($name, $subtests, @args) = @_;
if ('CODE' ne ref $subtests) {
$self->croak("subtest()'s second argument must be a code ref");
@@ -139,18 +158,23 @@ sub subtest {
# Turn the child into the parent so anyone who has stored a copy of
# the Test::Builder singleton will get the child.
- my($error, $child, %parent);
+ my $error;
+ my $child;
+ my $parent = {};
{
# child() calls reset() which sets $Level to 1, so we localize
# $Level first to limit the scope of the reset to the subtest.
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ # Store the guts of $self as $parent and turn $child into $self.
$child = $self->child($name);
- %parent = %$self;
- %$self = %$child;
+ _copy($self, $parent);
+ _copy($child, $self);
my $run_the_subtests = sub {
- $subtests->();
+ # Add subtest name for clarification of starting point
+ $self->note("Subtest: $name");
+ $subtests->(@args);
$self->done_testing unless $self->_plan_handled;
1;
};
@@ -161,8 +185,8 @@ sub subtest {
}
# Restore the parent and the copied child.
- %$child = %$self;
- %$self = %parent;
+ _copy($self, $child);
+ _copy($parent, $self);
# Restore the parent's $TODO
$self->find_TODO(undef, 1, $child->{Parent_TODO});
@@ -171,10 +195,14 @@ sub subtest {
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
local $Test::Builder::Level = $Test::Builder::Level + 1;
- return $child->finalize;
+ my $finalize = $child->finalize;
+
+ $self->BAIL_OUT($child->{Bailed_Out_Reason}) if $child->{Bailed_Out};
+
+ return $finalize;
}
-#line 281
+#line 312
sub _plan_handled {
my $self = shift;
@@ -182,7 +210,7 @@ sub _plan_handled {
}
-#line 306
+#line 337
sub finalize {
my $self = shift;
@@ -201,14 +229,16 @@ sub finalize {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = 1;
$self->parent->{Child_Name} = undef;
- if ( $self->{Skip_All} ) {
- $self->parent->skip($self->{Skip_All});
- }
- elsif ( not @{ $self->{Test_Results} } ) {
- $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
- }
- else {
- $self->parent->ok( $self->is_passing, $self->name );
+ unless ($self->{Bailed_Out}) {
+ if ( $self->{Skip_All} ) {
+ $self->parent->skip($self->{Skip_All}, $self->name);
+ }
+ elsif ( not @{ $self->{Test_Results} } ) {
+ $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
+ }
+ else {
+ $self->parent->ok( $self->is_passing, $self->name );
+ }
}
$? = $self->{Child_Error};
delete $self->{Parent};
@@ -226,11 +256,11 @@ sub _indent {
return $self->{Indent};
}
-#line 359
+#line 392
sub parent { shift->{Parent} }
-#line 371
+#line 404
sub name { shift->{Name} }
@@ -246,7 +276,7 @@ FAIL
}
}
-#line 395
+#line 428
our $Level;
@@ -269,7 +299,6 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
$self->{Child_Name} = undef;
$self->{Indent} ||= '';
- share( $self->{Curr_Test} );
$self->{Curr_Test} = 0;
$self->{Test_Results} = &share( [] );
@@ -288,12 +317,26 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
$self->{Start_Todo} = 0;
$self->{Opened_Testhandles} = 0;
+ $self->_share_keys;
$self->_dup_stdhandles;
return;
}
-#line 474
+
+# Shared scalar values are lost when a hash is copied, so we have
+# a separate method to restore them.
+# Shared references are retained across copies.
+sub _share_keys {
+ my $self = shift;
+
+ share( $self->{Curr_Test} );
+
+ return;
+}
+
+
+#line 520
my %plan_cmds = (
no_plan => \&no_plan,
@@ -340,7 +383,7 @@ sub _plan_tests {
return;
}
-#line 529
+#line 575
sub expected_tests {
my $self = shift;
@@ -358,7 +401,7 @@ sub expected_tests {
return $self->{Expected_Tests};
}
-#line 553
+#line 599
sub no_plan {
my($self, $arg) = @_;
@@ -371,7 +414,7 @@ sub no_plan {
return 1;
}
-#line 586
+#line 632
sub _output_plan {
my($self, $max, $directive, $reason) = @_;
@@ -390,7 +433,7 @@ sub _output_plan {
}
-#line 638
+#line 684
sub done_testing {
my($self, $num_tests) = @_;
@@ -433,7 +476,7 @@ sub done_testing {
}
-#line 689
+#line 735
sub has_plan {
my $self = shift;
@@ -443,7 +486,7 @@ sub has_plan {
return(undef);
}
-#line 706
+#line 752
sub skip_all {
my( $self, $reason ) = @_;
@@ -457,7 +500,7 @@ sub skip_all {
exit(0);
}
-#line 731
+#line 777
sub exported_to {
my( $self, $pack ) = @_;
@@ -468,7 +511,7 @@ sub exported_to {
return $self->{Exported_To};
}
-#line 761
+#line 807
sub ok {
my( $self, $test, $name ) = @_;
@@ -625,10 +668,10 @@ sub _is_dualvar {
no warnings 'numeric';
my $numval = $val + 0;
- return $numval != 0 and $numval ne $val ? 1 : 0;
+ return ($numval != 0 and $numval ne $val ? 1 : 0);
}
-#line 939
+#line 985
sub is_eq {
my( $self, $got, $expect, $name ) = @_;
@@ -707,7 +750,7 @@ sub _isnt_diag {
DIAGNOSTIC
}
-#line 1032
+#line 1078
sub isnt_eq {
my( $self, $got, $dont_expect, $name ) = @_;
@@ -741,30 +784,37 @@ sub isnt_num {
return $self->cmp_ok( $got, '!=', $dont_expect, $name );
}
-#line 1081
+#line 1127
sub like {
- my( $self, $this, $regex, $name ) = @_;
+ my( $self, $thing, $regex, $name ) = @_;
local $Level = $Level + 1;
- return $self->_regex_ok( $this, $regex, '=~', $name );
+ return $self->_regex_ok( $thing, $regex, '=~', $name );
}
sub unlike {
- my( $self, $this, $regex, $name ) = @_;
+ my( $self, $thing, $regex, $name ) = @_;
local $Level = $Level + 1;
- return $self->_regex_ok( $this, $regex, '!~', $name );
+ return $self->_regex_ok( $thing, $regex, '!~', $name );
}
-#line 1105
+#line 1151
my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
+# Bad, these are not comparison operators. Should we include more?
+my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
+
sub cmp_ok {
my( $self, $got, $type, $expect, $name ) = @_;
- my $test;
+ if ($cmp_ok_bl{$type}) {
+ $self->croak("$type is not a valid comparison operator in cmp_ok()");
+ }
+
+ my ($test, $succ);
my $error;
{
## no critic (BuiltinFunctions::ProhibitStringyEval)
@@ -774,9 +824,10 @@ sub cmp_ok {
my($pack, $file, $line) = $self->caller();
# This is so that warnings come out at the caller's level
- $test = eval qq[
+ $succ = eval qq[
#line $line "(eval in cmp_ok) $file"
-\$got $type \$expect;
+\$test = (\$got $type \$expect);
+1;
];
$error = $@;
}
@@ -790,7 +841,7 @@ sub cmp_ok {
? '_unoverload_num'
: '_unoverload_str';
- $self->diag(<<"END") if $error;
+ $self->diag(<<"END") unless $succ;
An error occurred while using $type:
------------------------------------
$error
@@ -838,28 +889,36 @@ sub _caller_context {
return $code;
}
-#line 1205
+#line 1259
sub BAIL_OUT {
my( $self, $reason ) = @_;
$self->{Bailed_Out} = 1;
+
+ if ($self->parent) {
+ $self->{Bailed_Out_Reason} = $reason;
+ $self->no_ending(1);
+ die bless {} => 'Test::Builder::Exception';
+ }
+
$self->_print("Bail out! $reason");
exit 255;
}
-#line 1218
+#line 1279
{
no warnings 'once';
*BAILOUT = \&BAIL_OUT;
}
-#line 1232
+#line 1293
sub skip {
- my( $self, $why ) = @_;
+ my( $self, $why, $name ) = @_;
$why ||= '';
+ $name = '' unless defined $name;
$self->_unoverload_str( \$why );
lock( $self->{Curr_Test} );
@@ -869,7 +928,7 @@ sub skip {
{
'ok' => 1,
actual_ok => 1,
- name => '',
+ name => $name,
type => 'skip',
reason => $why,
}
@@ -886,7 +945,7 @@ sub skip {
return 1;
}
-#line 1273
+#line 1335
sub todo_skip {
my( $self, $why ) = @_;
@@ -914,7 +973,7 @@ sub todo_skip {
return 1;
}
-#line 1353
+#line 1415
sub maybe_regex {
my( $self, $regex ) = @_;
@@ -949,7 +1008,7 @@ sub _is_qr {
}
sub _regex_ok {
- my( $self, $this, $regex, $cmp, $name ) = @_;
+ my( $self, $thing, $regex, $cmp, $name ) = @_;
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
@@ -961,14 +1020,19 @@ sub _regex_ok {
}
{
- ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
my $test;
my $context = $self->_caller_context;
- local( $@, $!, $SIG{__DIE__} ); # isolate eval
+ {
+ ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+ local( $@, $!, $SIG{__DIE__} ); # isolate eval
- $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
+ # No point in issuing an uninit warning, they'll see it in the diagnostics
+ no warnings 'uninitialized';
+
+ $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0};
+ }
$test = !$test if $cmp eq '!~';
@@ -977,11 +1041,11 @@ sub _regex_ok {
}
unless($ok) {
- $this = defined $this ? "'$this'" : 'undef';
+ $thing = defined $thing ? "'$thing'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
local $Level = $Level + 1;
- $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
+ $self->diag( sprintf <<'DIAGNOSTIC', $thing, $match, $regex );
%s
%13s '%s'
DIAGNOSTIC
@@ -994,7 +1058,7 @@ DIAGNOSTIC
# I'm not ready to publish this. It doesn't deal with array return
# values from the code or context.
-#line 1449
+#line 1516
sub _try {
my( $self, $code, %opts ) = @_;
@@ -1014,7 +1078,7 @@ sub _try {
return wantarray ? ( $return, $error ) : $return;
}
-#line 1478
+#line 1545
sub is_fh {
my $self = shift;
@@ -1028,7 +1092,7 @@ sub is_fh {
eval { tied($maybe_fh)->can('TIEHANDLE') };
}
-#line 1521
+#line 1588
sub level {
my( $self, $level ) = @_;
@@ -1039,7 +1103,7 @@ sub level {
return $Level;
}
-#line 1553
+#line 1620
sub use_numbers {
my( $self, $use_nums ) = @_;
@@ -1050,7 +1114,7 @@ sub use_numbers {
return $self->{Use_Nums};
}
-#line 1586
+#line 1653
foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
my $method = lc $attribute;
@@ -1068,7 +1132,7 @@ foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
*{ __PACKAGE__ . '::' . $method } = $code;
}
-#line 1639
+#line 1706
sub diag {
my $self = shift;
@@ -1076,7 +1140,7 @@ sub diag {
$self->_print_comment( $self->_diag_fh, @_ );
}
-#line 1654
+#line 1721
sub note {
my $self = shift;
@@ -1113,7 +1177,7 @@ sub _print_comment {
return 0;
}
-#line 1704
+#line 1771
sub explain {
my $self = shift;
@@ -1132,7 +1196,7 @@ sub explain {
} @_;
}
-#line 1733
+#line 1800
sub _print {
my $self = shift;
@@ -1161,7 +1225,7 @@ sub _print_to_fh {
return print $fh $indent, $msg;
}
-#line 1793
+#line 1860
sub output {
my( $self, $fh ) = @_;
@@ -1288,7 +1352,7 @@ sub _apply_layers {
}
-#line 1926
+#line 1993
sub reset_outputs {
my $self = shift;
@@ -1300,7 +1364,7 @@ sub reset_outputs {
return;
}
-#line 1952
+#line 2019
sub _message_at_caller {
my $self = shift;
@@ -1321,7 +1385,7 @@ sub croak {
}
-#line 1992
+#line 2059
sub current_test {
my( $self, $num ) = @_;
@@ -1354,7 +1418,7 @@ sub current_test {
return $self->{Curr_Test};
}
-#line 2040
+#line 2107
sub is_passing {
my $self = shift;
@@ -1367,7 +1431,7 @@ sub is_passing {
}
-#line 2062
+#line 2129
sub summary {
my($self) = shift;
@@ -1375,14 +1439,14 @@ sub summary {
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
-#line 2117
+#line 2184
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
-#line 2146
+#line 2213
sub todo {
my( $self, $pack ) = @_;
@@ -1396,7 +1460,7 @@ sub todo {
return '';
}
-#line 2173
+#line 2240
sub find_TODO {
my( $self, $pack, $set, $new_value ) = @_;
@@ -1410,7 +1474,7 @@ sub find_TODO {
return $old_value;
}
-#line 2193
+#line 2260
sub in_todo {
my $self = shift;
@@ -1419,7 +1483,7 @@ sub in_todo {
return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
}
-#line 2243
+#line 2310
sub todo_start {
my $self = shift;
@@ -1434,7 +1498,7 @@ sub todo_start {
return;
}
-#line 2265
+#line 2332
sub todo_end {
my $self = shift;
@@ -1455,7 +1519,7 @@ sub todo_end {
return;
}
-#line 2298
+#line 2365
sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
my( $self, $height ) = @_;
@@ -1470,9 +1534,9 @@ sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
return wantarray ? @caller : $caller[0];
}
-#line 2315
+#line 2382
-#line 2329
+#line 2396
#'#
sub _sanity_check {
@@ -1485,7 +1549,7 @@ sub _sanity_check {
return;
}
-#line 2350
+#line 2417
sub _whoa {
my( $self, $check, $desc ) = @_;
@@ -1500,7 +1564,7 @@ WHOA
return;
}
-#line 2374
+#line 2441
sub _my_exit {
$? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars)
@@ -1508,7 +1572,7 @@ sub _my_exit {
return 1;
}
-#line 2386
+#line 2453
sub _ending {
my $self = shift;
@@ -1527,6 +1591,26 @@ sub _ending {
if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
$self->is_passing(0);
$self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
+
+ if($real_exit_code) {
+ $self->diag(<<"FAIL");
+Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
+FAIL
+ $self->is_passing(0);
+ _my_exit($real_exit_code) && return;
+ }
+
+ # But if the tests ran, handle exit code.
+ my $test_results = $self->{Test_Results};
+ if(@$test_results) {
+ my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
+ if ($num_failed > 0) {
+
+ my $exit_code = $num_failed <= 254 ? $num_failed : 254;
+ _my_exit($exit_code) && return;
+ }
+ }
+ _my_exit(254) && return;
}
# Exit if plan() was never called. This is so "require Test::Simple"
@@ -1627,7 +1711,7 @@ END {
$Test->_ending if defined $Test;
}
-#line 2574
+#line 2669
1;
@@ -10,7 +10,7 @@ use warnings;
# We use a lot of subroutine prototypes
## no critic (Subroutines::ProhibitSubroutinePrototypes)
-# Can't use Carp because it might cause use_ok() to accidentally succeed
+# Can't use Carp because it might cause C<use_ok()> to accidentally succeed
# even though the module being used forgot to use Carp. Yes, this
# actually happened.
sub _carp {
@@ -18,10 +18,10 @@ sub _carp {
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.98';
+our $VERSION = '1.001009';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-use Test::Builder::Module;
+use Test::Builder::Module 0.99;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
@@ -38,7 +38,7 @@ our @EXPORT = qw(ok use_ok require_ok
BAIL_OUT
);
-#line 164
+#line 163
sub plan {
my $tb = Test::More->builder;
@@ -72,14 +72,14 @@ sub import_extra {
return;
}
-#line 217
+#line 216
sub done_testing {
my $tb = Test::More->builder;
$tb->done_testing(@_);
}
-#line 289
+#line 288
sub ok ($;$) {
my( $test, $name ) = @_;
@@ -88,7 +88,7 @@ sub ok ($;$) {
return $tb->ok( $test, $name );
}
-#line 372
+#line 371
sub is ($$;$) {
my $tb = Test::More->builder;
@@ -103,6 +103,7 @@ sub isnt ($$;$) {
}
*isn't = \&isnt;
+# ' to unconfuse syntax higlighters
#line 416
@@ -120,7 +121,7 @@ sub unlike ($$;$) {
return $tb->unlike(@_);
}
-#line 476
+#line 477
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
@@ -128,7 +129,7 @@ sub cmp_ok($$$;$) {
return $tb->cmp_ok(@_);
}
-#line 511
+#line 512
sub can_ok ($@) {
my( $proto, @methods ) = @_;
@@ -162,67 +163,89 @@ sub can_ok ($@) {
return $ok;
}
-#line 577
+#line 578
sub isa_ok ($$;$) {
- my( $object, $class, $obj_name ) = @_;
+ my( $thing, $class, $thing_name ) = @_;
my $tb = Test::More->builder;
- my $diag;
+ my $whatami;
+ if( !defined $thing ) {
+ $whatami = 'undef';
+ }
+ elsif( ref $thing ) {
+ $whatami = 'reference';
- if( !defined $object ) {
- $obj_name = 'The thing' unless defined $obj_name;
- $diag = "$obj_name isn't defined";
+ local($@,$!);
+ require Scalar::Util;
+ if( Scalar::Util::blessed($thing) ) {
+ $whatami = 'object';
+ }
}
else {
- my $whatami = ref $object ? 'object' : 'class';
- # We can't use UNIVERSAL::isa because we want to honor isa() overrides
- my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } );
- if($error) {
- if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
- # Its an unblessed reference
- $obj_name = 'The reference' unless defined $obj_name;
- if( !UNIVERSAL::isa( $object, $class ) ) {
- my $ref = ref $object;
- $diag = "$obj_name isn't a '$class' it's a '$ref'";
- }
- }
- elsif( $error =~ /Can't call method "isa" without a package/ ) {
- # It's something that can't even be a class
- $obj_name = 'The thing' unless defined $obj_name;
- $diag = "$obj_name isn't a class or reference";
- }
- else {
- die <<WHOA;
+ $whatami = 'class';
+ }
+
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } );
+
+ if($error) {
+ die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/;
WHOA! I tried to call ->isa on your $whatami and got some weird error.
Here's the error.
$error
WHOA
- }
- }
- else {
- $obj_name = "The $whatami" unless defined $obj_name;
- if( !$rslt ) {
- my $ref = ref $object;
- $diag = "$obj_name isn't a '$class' it's a '$ref'";
- }
- }
}
- my $name = "$obj_name isa $class";
- my $ok;
- if($diag) {
- $ok = $tb->ok( 0, $name );
- $tb->diag(" $diag\n");
+ # Special case for isa_ok( [], "ARRAY" ) and like
+ if( $whatami eq 'reference' ) {
+ $rslt = UNIVERSAL::isa($thing, $class);
+ }
+
+ my($diag, $name);
+ if( defined $thing_name ) {
+ $name = "'$thing_name' isa '$class'";
+ $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined";
+ }
+ elsif( $whatami eq 'object' ) {
+ my $my_class = ref $thing;
+ $thing_name = qq[An object of class '$my_class'];
+ $name = "$thing_name isa '$class'";
+ $diag = "The object of class '$my_class' isn't a '$class'";
+ }
+ elsif( $whatami eq 'reference' ) {
+ my $type = ref $thing;
+ $thing_name = qq[A reference of type '$type'];
+ $name = "$thing_name isa '$class'";
+ $diag = "The reference of type '$type' isn't a '$class'";
+ }
+ elsif( $whatami eq 'undef' ) {
+ $thing_name = 'undef';
+ $name = "$thing_name isa '$class'";
+ $diag = "$thing_name isn't defined";
+ }
+ elsif( $whatami eq 'class' ) {
+ $thing_name = qq[The class (or class-like) '$thing'];
+ $name = "$thing_name isa '$class'";
+ $diag = "$thing_name isn't a '$class'";
}
else {
+ die;
+ }
+
+ my $ok;
+ if($rslt) {
$ok = $tb->ok( 1, $name );
}
+ else {
+ $ok = $tb->ok( 0, $name );
+ $tb->diag(" $diag\n");
+ }
return $ok;
}
-#line 656
+#line 679
sub new_ok {
my $tb = Test::More->builder;
@@ -231,7 +254,6 @@ sub new_ok {
my( $class, $args, $object_name ) = @_;
$args ||= [];
- $object_name = "The object" unless defined $object_name;
my $obj;
my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
@@ -240,14 +262,15 @@ sub new_ok {
isa_ok $obj, $class, $object_name;
}
else {
- $tb->ok( 0, "new() died" );
+ $class = 'undef' if !defined $class;
+ $tb->ok( 0, "$class->new() died" );
$tb->diag(" Error was: $error");
}
return $obj;
}
-#line 741
+#line 765
sub subtest {
my ($name, $subtests) = @_;
@@ -256,7 +279,7 @@ sub subtest {
return $tb->subtest(@_);
}
-#line 765
+#line 789
sub pass (;$) {
my $tb = Test::More->builder;
@@ -270,7 +293,52 @@ sub fail (;$) {
return $tb->ok( 0, @_ );
}
-#line 833
+#line 842
+
+sub require_ok ($) {
+ my($module) = shift;
+ my $tb = Test::More->builder;
+
+ my $pack = caller;
+
+ # Try to determine if we've been given a module name or file.
+ # Module names must be barewords, files not.
+ $module = qq['$module'] unless _is_module_name($module);
+
+ my $code = <<REQUIRE;
+package $pack;
+require $module;
+1;
+REQUIRE
+
+ my( $eval_result, $eval_error ) = _eval($code);
+ my $ok = $tb->ok( $eval_result, "require $module;" );
+
+ unless($ok) {
+ chomp $eval_error;
+ $tb->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $eval_error
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+sub _is_module_name {
+ my $module = shift;
+
+ # Module names start with a letter.
+ # End with an alphanumeric.
+ # The rest is an alphanumeric or ::
+ $module =~ s/\b::\b//g;
+
+ return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
+}
+
+
+#line 936
sub use_ok ($;@) {
my( $module, @imports ) = @_;
@@ -278,6 +346,7 @@ sub use_ok ($;@) {
my $tb = Test::More->builder;
my( $pack, $filename, $line ) = caller;
+ $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
my $code;
if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
@@ -285,6 +354,8 @@ sub use_ok ($;@) {
# for it to work with non-Exporter based modules.
$code = <<USE;
package $pack;
+
+#line $line $filename
use $module $imports[0];
1;
USE
@@ -292,6 +363,8 @@ USE
else {
$code = <<USE;
package $pack;
+
+#line $line $filename
use $module \@{\$args[0]};
1;
USE
@@ -332,51 +405,8 @@ sub _eval {
return( $eval_result, $eval_error );
}
-#line 902
-
-sub require_ok ($) {
- my($module) = shift;
- my $tb = Test::More->builder;
-
- my $pack = caller;
-
- # Try to determine if we've been given a module name or file.
- # Module names must be barewords, files not.
- $module = qq['$module'] unless _is_module_name($module);
-
- my $code = <<REQUIRE;
-package $pack;
-require $module;
-1;
-REQUIRE
-
- my( $eval_result, $eval_error ) = _eval($code);
- my $ok = $tb->ok( $eval_result, "require $module;" );
-
- unless($ok) {
- chomp $eval_error;
- $tb->diag(<<DIAGNOSTIC);
- Tried to require '$module'.
- Error: $eval_error
-DIAGNOSTIC
-
- }
-
- return $ok;
-}
-
-sub _is_module_name {
- my $module = shift;
-
- # Module names start with a letter.
- # End with an alphanumeric.
- # The rest is an alphanumeric or ::
- $module =~ s/\b::\b//g;
-
- return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
-}
-#line 979
+#line 1037
our( @Data_Stack, %Refs_Seen );
my $DNE = bless [], 'Does::Not::Exist';
@@ -483,7 +513,7 @@ sub _type {
return '';
}
-#line 1139
+#line 1197
sub diag {
return Test::More->builder->diag(@_);
@@ -493,13 +523,13 @@ sub note {
return Test::More->builder->note(@_);
}
-#line 1165
+#line 1223
sub explain {
return Test::More->builder->explain(@_);
}
-#line 1231
+#line 1289
## no critic (Subroutines::RequireFinalReturn)
sub skip {
@@ -527,7 +557,7 @@ sub skip {
last SKIP;
}
-#line 1315
+#line 1373
sub todo_skip {
my( $why, $how_many ) = @_;
@@ -548,7 +578,7 @@ sub todo_skip {
last TODO;
}
-#line 1370
+#line 1428
sub BAIL_OUT {
my $reason = shift;
@@ -557,7 +587,7 @@ sub BAIL_OUT {
$tb->BAIL_OUT($reason);
}
-#line 1409
+#line 1467
#'#
sub eq_array {
@@ -697,7 +727,7 @@ WHOA
}
}
-#line 1556
+#line 1614
sub eq_hash {
local @Data_Stack = ();
@@ -732,7 +762,7 @@ sub _eq_hash {
return $ok;
}
-#line 1615
+#line 1673
sub eq_set {
my( $a1, $a2 ) = @_;
@@ -757,6 +787,6 @@ sub eq_set {
);
}
-#line 1817
+#line 1946
1;
@@ -4,7 +4,7 @@ use lib 'lib';
use lib 'inc';
use Test::Base -Base;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
our $NoLongString;
@@ -477,7 +477,7 @@ agentzh (章亦春) C<< <agentzh@gmail.com> >>
=head1 COPYRIGHT & LICENSE
-Copyright (c) 2009-2012, agentzh C<< <agentzh@gmail.com> >>.
+Copyright (c) 2009-2014, agentzh C<< <agentzh@gmail.com> >>.
This module is licensed under the terms of the BSD license.
@@ -13,7 +13,7 @@ if ($code) {
if ($config =~ /init_by_lua_file/) {
return $config;
}
- unless ($config =~ s{init_by_lua\s*(['"])((?:\\.|.)*)\1\s*;}{init_by_lua $1$code$2$1;}s) {
+ unless ($config =~ s{(?<!\# )(?<!\# )(?<!\#)init_by_lua\s*(['"])((?:\\.|.)*)\1\s*;}{init_by_lua $1$code$2$1;}s) {
$config .= "init_by_lua '$code';";
}
return $config;
@@ -5,7 +5,7 @@ use lib 'inc';
use Test::Base -Base;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use POSIX qw( SIGQUIT SIGKILL SIGTERM SIGHUP );
use Encode;
@@ -18,58 +18,7 @@ use IO::Select ();
use File::Temp qw( tempfile );
use POSIX ":sys_wait_h";
-use Test::Nginx::Util qw(
- check_accum_error_log
- is_running
- $NoLongString
- no_long_string
- $ServerAddr
- server_addr
- $ServerName
- server_name
- parse_time
- $UseStap
- verbose
- sleep_time
- stap_out_fh
- stap_out_fname
- setup_server_root
- write_config_file
- get_canon_version
- get_nginx_version
- bail_out
- trim
- show_all_chars
- get_pid_from_pidfile
- parse_headers
- run_tests
- $ServerPortForClient
- $ServerPort
- $PidFile
- $ServRoot
- $ConfFile
- $RunTestHelper
- $FilterHttpConfig
- $RepeatEach
- $CheckLeak
- timeout
- error_log_data
- worker_connections
- master_process_enabled
- config_preamble
- repeat_each
- workers
- master_on
- master_off
- log_level
- no_shuffle
- no_root_location
- server_root
- html_dir
- server_port
- server_port_for_client
- no_nginx_manager
-);
+use Test::Nginx::Util;
#use Smart::Comments::JSON '###';
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
@@ -78,7 +27,7 @@ use IO::Socket;
#our ($PrevRequest, $PrevConfig);
-our @EXPORT = qw( plan run_tests run_test
+our @EXPORT = qw( is_str plan run_tests run_test
repeat_each config_preamble worker_connections
master_process_enabled
no_long_string workers master_on master_off
@@ -86,6 +35,8 @@ our @EXPORT = qw( plan run_tests run_test
server_name
server_addr server_root html_dir server_port server_port_for_client
timeout no_nginx_manager check_accum_error_log
+ add_block_preprocessor bail_out add_cleanup_handler
+ add_response_body_check
);
our $TotalConnectingTimeouts = 0;
@@ -99,18 +50,26 @@ sub test_stap ($$);
sub error_event_handler ($);
sub read_event_handler ($);
sub write_event_handler ($);
-sub check_response_body ($$$$$);
+sub check_response_body ($$$$$$);
sub fmt_str ($);
-sub gen_cmd_from_req ($$);
+sub gen_ab_cmd_from_req ($$@);
+sub gen_curl_cmd_from_req ($$);
sub get_linear_regression_slope ($);
sub value_contains ($$);
$RunTestHelper = \&run_test_helper;
+$CheckErrorLog = \&check_error_log;
sub set_http_config_filter ($) {
$FilterHttpConfig = shift;
}
+our @ResponseBodyChecks;
+
+sub add_response_body_check ($) {
+ push @ResponseBodyChecks, shift;
+}
+
# This will parse a "request"" string. The expected format is:
# - One line for the HTTP verb (POST, GET, etc.) plus optional relative URL
# (default is /) plus optional HTTP version (default is HTTP/1.1).
@@ -133,7 +92,7 @@ sub parse_request ($$) {
my ($rel_url, $rel_url_size, $after_rel_url);
my ($http_ver, $http_ver_size, $after_http_ver);
my $end_line_size;
- if ($first =~ /^(\s*)(\S+)( *)((\S+)( *))?((\S+)( *))?(\s*)/) {
+ if ($first =~ /^(\s*)(\S+)( *)((\S+)( *))?((\S+)( *))?(\s*)$/) {
$before_meth = defined $1 ? length($1) : undef;
$meth = $2;
$after_meth = defined $3 ? length($3) : undef;
@@ -153,7 +112,7 @@ sub parse_request ($$) {
}
$end_line_size = defined $10 ? length($10) : undef;
} else {
- bail_out("$name - Request line is not valid. Should be 'meth [url [version]]'");
+ bail_out("$name - Request line is not valid. Should be 'meth [url [version]]' but got \"$first\".");
}
if ( !defined $rel_url ) {
$rel_url = '/';
@@ -294,17 +253,32 @@ sub build_request_from_packets($$$$$) {
if ( !$is_chunked
&& defined $parsed_req->{content}
&& $parsed_req->{content} ne ''
- && $more_headers !~ /\bContent-Length:/ )
+ && $more_headers !~ /(?:^|\n)Content-Length:/ )
{
$parsed_req->{content} =~ s/^\s+|\s+$//gs;
$len_header .=
"Content-Length: " . length( $parsed_req->{content} ) . "\r\n";
}
+
+ $more_headers =~ s/(?<!\r)\n/\r\n/gs;
+
+ my $headers = '';
+
+ if ($more_headers !~ /(?:^|\n)Host:/msi) {
+ $headers .= "Host: $ServerName\r\n";
+ }
+
+ if ($more_headers !~ /(?:^|\n)Connection/msi) {
+ $headers .= "Connection: $conn_header\r\n";
+ }
+
+ $headers .= "$more_headers$len_header\r\n";
+
$parsed_req->{method} .= ' ';
$parsed_req->{url} .= ' ';
$parsed_req->{http_ver} .= "\r\n";
- $parsed_req->{headers} = "Host: $ServerName\r\nConnection: $conn_header\r\n$more_headers$len_header\r\n";
+ $parsed_req->{headers} = $headers;
# Get the moves from parsing
my @elements_moves = get_moves($parsed_req);
@@ -312,6 +286,24 @@ sub build_request_from_packets($$$$$) {
return apply_moves($request_packets, \@elements_moves);
}
+sub parse_more_headers ($) {
+ my ($in) = @_;
+ my @headers = split /\n+/, $in;
+ my $is_chunked;
+ my $out = '';
+ for my $header (@headers) {
+ next if $header =~ /^\s*\#/;
+ my ($key, $val) = split /:\s*/, $header, 2;
+ if (lc($key) eq 'transfer-encoding' and $val eq 'chunked') {
+ $is_chunked = 1;
+ }
+
+ #warn "[$key, $val]\n";
+ $out .= "$key: $val\r\n";
+ }
+ return $out, $is_chunked;
+}
+
# Returns an array of array of hashes from the block. Each element of
# the first-level array is a request.
# Each request is an array of the "packets" to be sent. Each packet is a
@@ -324,57 +316,49 @@ sub get_req_from_block ($) {
my @req_list = ();
- if ( defined $block->raw_request ) {
+ if (defined $block->raw_request) {
# Should be deprecated.
- if ( ref $block->raw_request && ref $block->raw_request eq 'ARRAY' ) {
+ if (ref $block->raw_request && ref $block->raw_request eq 'ARRAY') {
# User already provided an array. So, he/she specified where the
# data should be split. This allows for backward compatibility but
# should use request with arrays as it provides the same functionnality.
my @rr_list = ();
- for my $elt ( @{ $block->raw_request } ) {
+ for my $elt (@{ $block->raw_request }) {
push @rr_list, {value => $elt};
}
push @req_list, \@rr_list;
- }
- else {
+
+ } else {
push @req_list, [{value => $block->raw_request}];
}
- }
- else {
+
+ } else {
my $request;
- if ( defined $block->request_eval ) {
+ if (defined $block->request_eval) {
diag "$name - request_eval DEPRECATED. Use request eval instead.";
$request = eval $block->request_eval;
if ($@) {
warn $@;
}
- }
- else {
- $request = $block->request;
- }
- my $is_chunked = 0;
- my $more_headers = '';
- if ( $block->more_headers ) {
- my @headers = split /\n+/, $block->more_headers;
- for my $header (@headers) {
- next if $header =~ /^\s*\#/;
- my ( $key, $val ) = split /:\s*/, $header, 2;
- if ( lc($key) eq 'transfer-encoding' and $val eq 'chunked' ) {
- $is_chunked = 1;
+ } else {
+ $request = $block->request;
+ if (defined $request) {
+ while ($request =~ s/^\s*\#[^\n]+\s+|^\s+//gs) {
+ # do nothing
}
-
- #warn "[$key, $val]\n";
- $more_headers .= "$key: $val\r\n";
}
+ #warn "my req: $request";
}
+ my $more_headers = $block->more_headers || '';
+
if ( $block->pipelined_requests ) {
my $reqs = $block->pipelined_requests;
- if ( !ref $reqs || ref $reqs ne 'ARRAY' ) {
+ if (!ref $reqs || ref $reqs ne 'ARRAY') {
bail_out(
"$name - invalid entries in --- pipelined_requests");
}
@@ -382,25 +366,49 @@ sub get_req_from_block ($) {
my $prq = "";
for my $request (@$reqs) {
my $conn_type;
- if ( $i++ == @$reqs - 1 ) {
+ if ($i == @$reqs - 1) {
$conn_type = 'close';
- }
- else {
+
+ } else {
$conn_type = 'keep-alive';
}
- my $r_br = build_request_from_packets($name, $more_headers,
+
+ my ($hdr, $is_chunked);
+ if (ref $more_headers eq 'ARRAY') {
+ #warn "Found ", scalar @$more_headers, " entries in --- more_headers.";
+ $hdr = $more_headers->[$i];
+ if (!defined $hdr) {
+ bail_out("--- more_headers lacks data for the $i pipelined request");
+ }
+ ($hdr, $is_chunked) = parse_more_headers($hdr);
+ #warn "more headers: $hdr";
+
+ } else {
+ ($hdr, $is_chunked) = parse_more_headers($more_headers);
+ }
+
+ my $r_br = build_request_from_packets($name, $hdr,
$is_chunked, $conn_type,
[$request] );
$prq .= $$r_br[0];
+ $i++;
}
push @req_list, [{value =>$prq}];
- }
- else {
+
+ } else {
+ my $is_chunked;
+ if ($more_headers) {
+ ($more_headers, $is_chunked) = parse_more_headers($more_headers);
+
+ } else {
+ $more_headers = '';
+ }
+
# request section.
if (!ref $request) {
# One request and it is a good old string.
my $r_br = build_request_from_packets($name, $more_headers,
- $is_chunked, 'Close',
+ $is_chunked, 'close',
[$request] );
push @req_list, [{value => $$r_br[0]}];
} elsif (ref $request eq 'ARRAY') {
@@ -409,7 +417,7 @@ sub get_req_from_block ($) {
if (!ref $one_req) {
# This request is a good old string.
my $r_br = build_request_from_packets($name, $more_headers,
- $is_chunked, 'Close',
+ $is_chunked, 'close',
[$one_req] );
push @req_list, [{value => $$r_br[0]}];
} elsif (ref $one_req eq 'ARRAY') {
@@ -427,7 +435,7 @@ sub get_req_from_block ($) {
}
}
my $transformed_packet_array = build_request_from_packets($name, $more_headers,
- $is_chunked, 'Close',
+ $is_chunked, 'close',
\@packet_array);
my @transformed_req = ();
my $idx = 0;
@@ -456,6 +464,25 @@ sub get_req_from_block ($) {
return \@req_list;
}
+sub quote_sh_args ($) {
+ my ($args) = @_;
+ for my $arg (@$args) {
+ if ($arg =~ m{^[- "&%;,|?*.+=\w:/()]*$}) {
+ if ($arg =~ /[ "&%;,|?*()]/) {
+ $arg = "'$arg'";
+ }
+ next;
+ }
+ $arg =~ s/\\/\\\\/g;
+ $arg =~ s/'/\\'/g;
+ $arg =~ s/\n/\\n/g;
+ $arg =~ s/\r/\\r/g;
+ $arg =~ s/\t/\\t/g;
+ $arg = "\$'$arg'";
+ }
+ return "@$args";
+}
+
sub run_test_helper ($$) {
my ($block, $dry_run, $repeated_req_idx) = @_;
@@ -469,15 +496,47 @@ sub run_test_helper ($$) {
bail_out("$name - request empty");
}
+ if (defined $block->curl) {
+ my $req = $r_req_list->[0];
+ my $cmd = gen_curl_cmd_from_req($block, $req);
+ warn "# ", quote_sh_args($cmd), "\n";
+ }
+
if ($CheckLeak) {
$dry_run = "the \"check leak\" testing mode";
}
+ if ($Benchmark) {
+ $dry_run = "the \"benchmark\" testing mode";
+ }
+
+ if ($Benchmark && !defined $block->no_check_leak) {
+ warn "$name\n";
+
+ my $req = $r_req_list->[0];
+ my ($nreqs, $concur);
+ if ($Benchmark =~ /^\s*(\d+)(?:\s+(\d+))?\s*$/) {
+ ($nreqs, $concur) = ($1, $2);
+ }
+
+ if ($BenchmarkWarmup) {
+ my $cmd = gen_ab_cmd_from_req($block, $req, $BenchmarkWarmup, $concur);
+ warn "Warming up with $BenchmarkWarmup requests...\n";
+ system @$cmd;
+ }
+
+ my $cmd = gen_ab_cmd_from_req($block, $req, $nreqs, $concur);
+ $cmd = quote_sh_args($cmd);
+
+ warn "$cmd\n";
+ system "unbuffer $cmd > /dev/stderr";
+ }
+
if ($CheckLeak && !defined $block->no_check_leak) {
warn "$name\n";
my $req = $r_req_list->[0];
- my $cmd = gen_cmd_from_req($block, $req);
+ my $cmd = gen_ab_cmd_from_req($block, $req);
# start a sub-process to run ab or weighttp
my $pid = fork();
@@ -639,10 +698,14 @@ again:
check_error_code($block, $res, $dry_run, $req_idx, $need_array);
check_raw_response_headers($block, $raw_headers, $dry_run, $req_idx, $need_array);
check_response_headers($block, $res, $raw_headers, $dry_run, $req_idx, $need_array);
- check_response_body($block, $res, $dry_run, $req_idx, $need_array);
+ check_response_body($block, $res, $dry_run, $req_idx, $repeated_req_idx, $need_array);
}
if ($n || $req_idx < @$r_req_list - 1) {
+ if ($block->wait) {
+ sleep($block->wait);
+ }
+
check_error_log($block, $res, $dry_run, $repeated_req_idx, $need_array);
}
@@ -899,6 +962,7 @@ sub check_error_log ($$$$) {
my $check_alert_message = 1;
my $check_crit_message = 1;
+ my $check_emerg_message = 1;
my $grep_pat;
my $grep_pats = $block->grep_error_log;
@@ -965,6 +1029,10 @@ sub check_error_log ($$$$) {
undef $check_crit_message;
}
+ if (value_contains($pats, "[emerg")) {
+ undef $check_emerg_message;
+ }
+
if (!ref $pats) {
chomp $pats;
my @lines = split /\n+/, $pats;
@@ -979,6 +1047,7 @@ sub check_error_log ($$$$) {
}
$lines ||= error_log_data();
+ #warn "error log data: ", join "\n", @$lines;
for my $line (@$lines) {
for my $pat (@$pats) {
next if !defined $pat;
@@ -1015,6 +1084,10 @@ sub check_error_log ($$$$) {
undef $check_crit_message;
}
+ if (value_contains($pats, "[emerg")) {
+ undef $check_emerg_message;
+ }
+
if (!ref $pats) {
chomp $pats;
my @lines = split /\n+/, $pats;
@@ -1028,24 +1101,33 @@ sub check_error_log ($$$$) {
$pats = \@clone;
}
+ my %found;
$lines ||= error_log_data();
for my $line (@$lines) {
for my $pat (@$pats) {
next if !defined $pat;
#warn "test $pat\n";
if ((ref $pat && $line =~ /$pat/) || $line =~ /\Q$pat\E/) {
+ if ($found{$pat}) {
+ my $tb = Test::More->builder;
+ $tb->no_ending(1);
+
+ } else {
+ $found{$pat} = 1;
+ }
+
SKIP: {
skip "$name - no_error_log - tests skipped due to $dry_run", 1 if $dry_run;
my $ln = fmt_str($line);
my $p = fmt_str($pat);
fail("$name - pattern \"$p\" should not match any line in error.log but matches line \"$ln\" (req $repeated_req_idx)");
}
- undef $pat;
}
}
}
for my $pat (@$pats) {
+ next if $found{$pat};
if (defined $pat) {
SKIP: {
skip "$name - no_error_log - tests skipped due to $dry_run", 1 if $dry_run;
@@ -1078,6 +1160,17 @@ sub check_error_log ($$$$) {
}
}
+ if ($check_emerg_message && !$dry_run) {
+ $lines ||= error_log_data();
+ for my $line (@$lines) {
+ #warn "test $pat\n";
+ if ($line =~ /\[emerg\]/) {
+ my $ln = fmt_str($line);
+ warn("WARNING: $name - $ln");
+ }
+ }
+ }
+
for my $line (@$lines) {
#warn "test $pat\n";
if ($line =~ /\bAssertion .*? failed\.$/) {
@@ -1099,8 +1192,8 @@ sub fmt_str ($) {
$str;
}
-sub check_response_body ($$$$$) {
- my ($block, $res, $dry_run, $req_idx, $need_array) = @_;
+sub check_response_body ($$$$$$) {
+ my ($block, $res, $dry_run, $req_idx, $repeated_req_idx, $need_array) = @_;
my $name = $block->name;
if ( defined $block->response_body
|| defined $block->response_body_eval )
@@ -1133,7 +1226,7 @@ sub check_response_body ($$$$$) {
Encode::from_to( $expected, 'UTF-8', $block->charset );
}
- unless (ref $expected) {
+ unless (!defined $expected || ref $expected) {
$expected =~ s/\$ServerPort\b/$ServerPort/g;
$expected =~ s/\$ServerPortForClient\b/$ServerPortForClient/g;
}
@@ -1144,16 +1237,16 @@ sub check_response_body ($$$$$) {
SKIP: {
skip "$name - response_body - tests skipped due to $dry_run", 1 if $dry_run;
if (ref $expected) {
- like $content, $expected, "$name - response_body - like";
+ like $content, $expected, "$name - response_body - like (req $repeated_req_idx)";
} else {
if ($NoLongString) {
is( $content, $expected,
- "$name - response_body - response is expected" );
+ "$name - response_body - response is expected (req $repeated_req_idx)" );
}
else {
is_string( $content, $expected,
- "$name - response_body - response is expected" );
+ "$name - response_body - response is expected (req $repeated_req_idx)" );
}
}
}
@@ -1198,6 +1291,10 @@ sub check_response_body ($$$$$) {
);
}
}
+
+ for my $check (@ResponseBodyChecks) {
+ $check->($block, $res->content, $req_idx, $repeated_req_idx, $dry_run);
+ }
}
sub parse_response($$$) {
@@ -1221,6 +1318,11 @@ sub parse_response($$$) {
my $enc = $res->header('Transfer-Encoding');
my $len = $res->header('Content-Length');
+ if ($code && $code !~ /^\d+$/) {
+ undef $code;
+ $res->code(undef);
+ }
+
if ($code && ($code == 304 || $code == 101)) {
return $res, $raw_headers
}
@@ -1431,13 +1533,13 @@ sub send_request ($$$$@) {
#warn "doing select...\n";
- my ( $new_readable, $new_writable, $new_err ) =
- IO::Select->select( $readable_hdls, $writable_hdls, $err_hdls,
- $timeout );
+ my ($new_readable, $new_writable, $new_err) =
+ IO::Select->select($readable_hdls, $writable_hdls, $err_hdls,
+ $timeout);
- if ( !defined $new_err
+ if (!defined $new_err
&& !defined $new_readable
- && !defined $new_writable )
+ && !defined $new_writable)
{
# timed out
@@ -1685,20 +1787,108 @@ sub read_event_handler ($) {
return undef;
}
-sub gen_cmd_from_req ($$) {
+sub gen_curl_cmd_from_req ($$) {
my ($block, $req) = @_;
my $name = $block->name;
$req = join '', map { $_->{value} } @$req;
- #warn "Req: $req\n";
+ #use JSON::XS;
+ #warn "Req: ", JSON::XS->new->encode([$req]), "\n";
my ($meth, $uri, $http_ver);
- if ($req =~ m{^\s*(\w+)\s+(.*\S)\s*HTTP/(\S+)\r\n}gcs) {
+ if ($req =~ m{^\s*(\w+)\s+(\S+)\s+HTTP/(\S+)\r?\n}smig) {
($meth, $uri, $http_ver) = ($1, $2, $3);
- } elsif ($req =~ m{^\s*(\w+)\s+(.*\S)\r\n}gcs) {
+ } elsif ($req =~ m{^\s*(\w+)\s+(.*\S)\r?\n}smig) {
+ ($meth, $uri) = ($1, $2);
+ $http_ver = '0.9';
+
+ } else {
+ bail_out "$name - cannot parse the status line in the request: $req";
+ }
+
+ my @args = ('curl', '-i');
+
+ if ($meth eq 'HEAD') {
+ push @args, '-I';
+
+ } elsif ($meth ne 'GET') {
+ warn "WARNING: --- curl: request method $meth not supported yet.\n";
+ }
+
+ if ($http_ver ne '1.1') {
+ # HTTP 1.0 or HTTP 0.9
+ push @args, '-0';
+ }
+
+ my @headers;
+ if ($http_ver ge '1.0') {
+ if ($req =~ m{\G(.*?)\r?\n\r?\n}gcs) {
+ my $headers = $1;
+ #warn "raw headers: $headers\n";
+ @headers = grep {
+ !/^Connection\s*:/i
+ && !/^Host: \Q$ServerName\E$/i
+ && !/^Content-Length\s*:/i
+ } split /\r\n/, $headers;
+
+ } else {
+ bail_out "cannot parse the header entries in the request: $req";
+ }
+ }
+
+ #warn "headers: @headers ", scalar(@headers), "\n";
+
+ for my $h (@headers) {
+ #warn "h: $h\n";
+ if ($h =~ /^\s*User-Agent\s*:\s*(.*\S)/i) {
+ push @args, '-A', $1;
+
+ } else {
+ push @args, '-H', $h;
+ }
+ }
+
+ if ($req =~ m{\G.+}gcs) {
+ warn "WARNING: --- curl: request body not supported.\n";
+ }
+
+ my $link;
+ {
+ my $server = $ServerAddr;
+ my $port = $ServerPortForClient;
+ $link = "http://$server:$port$uri";
+ }
+
+ push @args, $link;
+
+ return \@args;
+}
+
+sub gen_ab_cmd_from_req ($$@) {
+ my ($block, $req, $nreqs, $concur) = @_;
+
+ $nreqs ||= 100000;
+ $concur ||= 2;
+
+ if ($nreqs < $concur) {
+ $concur = $nreqs;
+ }
+
+ my $name = $block->name;
+
+ $req = join '', map { $_->{value} } @$req;
+
+ #use JSON::XS;
+ #warn "Req: ", JSON::XS->new->encode([$req]), "\n";
+
+ my ($meth, $uri, $http_ver);
+ if ($req =~ m{^\s*(\w+)\s+(\S+)\s+HTTP/(\S+)\r?\n}smig) {
+ ($meth, $uri, $http_ver) = ($1, $2, $3);
+
+ } elsif ($req =~ m{^\s*(\w+)\s+(.*\S)\r?\n}smig) {
($meth, $uri) = ($1, $2);
$http_ver = '0.9';
@@ -1708,7 +1898,7 @@ sub gen_cmd_from_req ($$) {
#warn "HTTP version: $http_ver\n";
- my @opts = ('-c2', '-k', '-n100000');
+ my @opts = ("-c$concur", '-k', "-n$nreqs");
my $prog;
if ($http_ver eq '1.1' && $meth eq 'GET') {
@@ -1722,7 +1912,7 @@ sub gen_cmd_from_req ($$) {
my @headers;
if ($http_ver ge '1.0') {
- if ($req =~ m{\G(.*?)\r\n\r\n}gcs) {
+ if ($req =~ m{\G(.*?)\r?\n\r?\n}gcs) {
my $headers = $1;
#warn "raw headers: $headers\n";
@headers = grep {
@@ -1769,6 +1959,9 @@ sub gen_cmd_from_req ($$) {
} elsif ($meth eq 'POST') {
push @opts, '-p', $bodyfile;
+ } elsif ($meth eq 'GET') {
+ warn "WARNING: method $meth not supported for ab when taking a request body\n";
+
} else {
warn "WARNING: method $meth not supported for ab when taking a request body\n";
$meth = 'PUT';
@@ -1924,7 +2117,7 @@ Other configuration Perl functions I<must> be called before calling this C<run_t
=head2 no_shuffle
By default, the test scaffold always shuffles the order of the test blocks automatically. Calling this function before
-calling C<run_tests> will disable the suffling.
+calling C<run_tests> will disable the shuffling.
=head2 no_long_string
@@ -1983,6 +2176,82 @@ By default, the Nginx configuration file generated by the test scaffold
automatically emits a C<location />. Calling this function before C<run_tests()>
disables this behavior such that the test blocks can have their own root locations.
+=head2 bail_out
+
+Aborting the whole test session (not just the current test file) with a specified message.
+
+This function will also do all the necessary cleanup work. So always use this function instead of calling C<Test::More::BAIL_OUT()> directly.
+
+For example,
+
+ bail_out("something bad happened!");
+
+=head2 add_cleanup_handler
+
+Rigister custom cleanup handler for the current perl/prove process by specifying a Perl subroutine object as the argument.
+
+For example,
+
+ add_cleanup_handler(sub {
+ kill INT => $my_own_child_pid;
+ $my_own_socket->close()
+ });
+
+=head2 add_block_preprocessor
+
+Add a custom Perl preprocessor to each test block by specifying a Perl subroutine object as the argument.
+
+The processor subroutine is always run right before processing the test block.
+
+This mechanism can be used to add custom sections or modify existing ones.
+
+For example,
+
+ add_block_preprocessor(sub {
+ my $block = shift;
+
+ # use "--- req_headers" for "--- more_Headers":
+ $block->set_value("more_headers", $block->req_headers);
+
+ # initialize external dependencies like memcached services...
+ });
+
+=head2 add_response_body_check
+
+Add custom checks for testing response bodies by specifying a Perl subroutine object as the argument.
+
+Below is an example for doing HTML title checks:
+
+ add_response_body_check(sub {
+ my ($block, $body, $req_idx, $repeated_req_idx, $dry_run) = @_;
+
+ my $name = $block->name;
+ my $expected_title = $block->resp_title;
+
+ if ($expected_title && !ref $expected_title) {
+ $expected_title =~ s/^\s*|\s*$//gs;
+ }
+
+ if (defined $expected_title) {
+ SKIP: {
+ skip "$name - resp_title - tests skipped due to $dry_run", 1 if $dry_run;
+
+ my $title;
+ if ($body =~ m{<\s*title\s*>\s*(.*?)<\s*/\s*title\s*>}) {
+ $title = $1;
+ $title =~ s/\s*$//s;
+ }
+
+ is_str($title, $expected_title,
+ "$name - resp_title (req $repeated_req_idx)" );
+ }
+ }
+ });
+
+=head2 is_str
+
+Performs intelligent string comparison subtests which honors both C<no_long_string> and regular expression references in the "expected" argument.
+
=head1 Sections supported
The following sections are supported:
@@ -2043,6 +2312,15 @@ variable expansion (variables have to start with TEST_NGINX).
Similar to C<main_config>, but the content will be put I<after> the C<http {}>
block generated by this module.
+=head2 server_name
+
+Specify a custom server name (via the "server_name" nginx config directive) for the
+current test block. Default to "localhost".
+
+=head2 init
+
+Run a piece of Perl code specified as the content of this C<--- init> section before running the tests for the blocks. Note that it is only run once before *all* the repeated requests for this test block.
+
=head2 request
This is probably the most important section. It defines the request(s) you
@@ -2065,7 +2343,7 @@ web server and even use a different version of HTTP. This is possible:
Please note that specifying HTTP/1.0 will not prevent Test::Nginx from
sending the C<Host> header. Actually Test::Nginx always sends 2 headers:
-C<Host> (with value localhost) and C<Connection> (with value Close for
+C<Host> (with value localhost) and C<Connection> (with value C<close> for
simple requests and keep-alive for all but the last pipelined_requests).
You can also add a content to your request:
@@ -2109,7 +2387,7 @@ your request into network packets:
Here, Test::Nginx will first send the request line, the headers it
automatically added for you and the first two letters of the body ("na" in
our example) in ONE network packet. Then, it will send the next packet (here
-it's "me=foo"). When we talk about packets here, this is nto exactly correct
+it's "me=foo"). When we talk about packets here, this is not exactly correct
as there is no way to guarantee the behavior of the TCP/IP stack. What
Test::Nginx can guarantee is that this will result in two calls to
C<syswrite>.
@@ -2130,6 +2408,13 @@ Of course, everything can be combined till your brain starts boiling ;) :
{value => substr($val, 6, 5), delay_before=>5},
substr($val, 11)], "GET /rrd/foo"]
+Adding comments before the actual request spec is also supported, for example,
+
+ --- request
+ # this request contains the URI args
+ # "foo" and "bar":
+ GET /api?foo=1&bar=2
+
=head2 request_eval
Use of this section is deprecated and tests using it should replace it with
@@ -2187,6 +2472,28 @@ This will add C<X-Foo: blah> to the request (on top of the automatically
generated headers like C<Host>, C<Connection> and potentially
C<Content-Length>).
+=head2 curl
+
+When this section is specified, the test scaffold will try generating a C<curl> command line for the (first) test request.
+
+For example,
+
+ --- request
+ GET /foo/bar?baz=3
+
+ --- more_headers
+ X-Foo: 3
+ User-Agent: openresty
+
+ --- curl
+
+will produce the following line (to C<stderr>) while running this test block:
+
+ # curl -i -H 'X-Foo: 3' -A openresty 'http://127.0.0.1:1984/foo/bar?baz=3'
+
+You need to remember to set the C<TEST_NGINX_NO_CLEAN> environment to 1 to prevent the nginx
+and other processes from quitting automatically upon test exits.
+
=head2 response_body
The expected value for the body of the submitted request.
@@ -2345,6 +2652,12 @@ An optional time unit can be specified, for example,
Acceptable time units are C<s> (seconds) and C<ms> (milliseconds). If no time unit is specified, then default to seconds.
+=head2 error_log_file
+
+Specify the global error log file for the current test block only.
+
+Right now, it will not affect the C<--- error_log> section and etc accordingly.
+
=head2 error_log
Checks if the pattern or multiple patterns all appear in lines of the F<error.log> file.
@@ -2387,7 +2700,7 @@ Makes the test scaffold not to treat C<--- timeout> expiration as a test failure
=head2 shutdown
-Perform a C<shutdown>() operaton on the client socket connecting to Nginx as soon as sending out
+Perform a C<shutdown>() operation on the client socket connecting to Nginx as soon as sending out
all the request data. This section takes an (optional) integer value for the argument to the
C<shutdown> function call. For example,
@@ -2464,13 +2777,13 @@ The default error log level can be specified in the Perl code by calling the C<l
=head2 raw_request
The exact request to send to nginx. This is useful when you want to test
-soem behaviors that are not available with "request" such as an erroneous
+some behaviors that are not available with "request" such as an erroneous
C<Content-Length> header or splitting packets right in the middle of headers:
--- raw_request eval
["POST /rrd/taratata HTTP/1.1\r
Host: localhost\r
- Connection: Close\r
+ Connection: close\r
Content-Type: application/",
"x-www-form-urlencoded\r
Content-Length:15\r\n\r\nvalue=N%3A12345"]
@@ -2517,6 +2830,29 @@ html directory of the nginx server under test. For example:
will create a file named C<blah.txt> in the html directory of the nginx
server tested. The file will contain the text "Hello, world".
+Multiple files are supported, for example,
+
+ --- user_files
+ >>> foo.txt
+ Hello, world!
+ >>> bar.txt
+ Hello, heaven!
+
+An optional last modified timestamp (in elpased seconds since Epoch) is supported, for example,
+
+ --- user_files
+ >>> blah.txt 199801171935.33
+ Hello, world
+
+It's also possible to specify a Perl data structure for the user files
+to be created, for example,
+
+ --- user_files eval
+ [
+ [ "foo.txt" => "Hello, world!", 199801171935.33 ],
+ [ "bar.txt" => "Hello, heaven!" ],
+ ]
+
=head2 skip_eval
Skip the specified number of subtests (in the current test block) if the result of running a piece of Perl code is true.
@@ -2566,7 +2902,7 @@ the skip condition. If you want to use two boolean expressions, you should use t
=head2 skip_nginx2
-This seciton is similar to C<skip_nginx>, but the skip condition consists of two boolean expressions joined by the operator C<and> or C<or>.
+This section is similar to C<skip_nginx>, but the skip condition consists of two boolean expressions joined by the operator C<and> or C<or>.
The format for this section is
@@ -2658,7 +2994,7 @@ will be expanded to
=head2 stap_out
-This seciton specifies the expected literal output of the systemtap script specified by C<stap>.
+This section specifies the expected literal output of the systemtap script specified by C<stap>.
=head2 stap_out_like
@@ -2671,7 +3007,7 @@ Just like C<stap_like>, but the subtest only passes when the specified pattern d
=head2 wait
Takes an integer value for the seconds of time to wait right after processing the Nginx response and
-before performing the error log and systemtap output checks.
+before performing the error log and/or systemtap output checks.
=head2 udp_listen
@@ -2728,11 +3064,28 @@ This section specifies the datagram reply content for the UDP server created by
You can also specify a delay time before sending out the reply via the C<udp_reply_delay> section. By default, there is no delay.
-An array value can be specified to make the embedded UDP server to send mulitple replies as specified, for example:
+An array value can be specified to make the embedded UDP server to send multiple replies as specified, for example:
--- udp_reply eval
[ "hello", "world" ]
+This section also accepts a Perl subroutine value that can be used to
+generate dynamic response packet or packets based on the actualactual query, for example:
+
+ --- udp_reply eval
+ sub {
+ my $req = shift;
+ return "hello, $req";
+ }
+
+The custom Perl subroutine can also return an array reference, for example,
+
+ --- udp_reply eval
+ sub {
+ my $req = shift;
+ return ["hello, $req", "hiya, $req"];
+ }
+
See the C<udp_listen> section for more details.
=head2 udp_reply_delay
@@ -2803,6 +3156,12 @@ Just like C<udp_query>, but for the embedded TCP server.
Specifies the expected TCP query received by the embedded TCP server.
+If C<tcp_query> is specified, C<tcp_query_len> defaults to the length of the value of C<tcp_query>.
+
+=head2 tcp_shutdown
+
+Shuts down the reading part, writing part, or both in the embedded TCP server as soon as a new connection is established. Its value specifies which part to shut down: 0 for read part only, 1 for write part only, and 2 for both directions.
+
=head2 raw_request_middle_delay
Delay in sec between sending successive packets in the "raw_request" array
@@ -2813,6 +3172,36 @@ value. Also used when a request is split in packets.
Skip the tests in the current test block in the "check leak" testing mode
(i.e, with C<TEST_NGINX_CHECK_LEAK>=1).
+=head2 must_die
+
+Test the cases that Nginx must die right after starting. If a value is specified, the exit code must match the specified value.
+
+Normal request and response cycle is not done. But you can still use the
+C<error_log> section to check if there is an error message to be seen.
+
+This is meant to test bogus configuration is noticed and given proper
+error message. It is normal to see stderr error message when running these tests.
+
+Below is an example:
+
+ === TEST 1: bad "return" directive
+ --- config
+ location = /t {
+ return a b c;
+ }
+ --- request
+ GET /t
+ --- must_die
+ --- error_log
+ invalid number of arguments in "return" directive
+ --- no_error_log
+ [error]
+
+This configuration ignores C<TEST_NGINX_USE_VALGRIND>
+C<TEST_NGINX_USE_STAP> or C<TEST_NGINX_CHECK_LEAK> since there is no point to check other things when the nginx is expected to die right away.
+
+This directive is handled before checking C<TEST_NGINX_IGNORE_MISSING_DIRECTIVES>.
+
=head1 Environment variables
All environment variables starting with C<TEST_NGINX_> are expanded in the
@@ -2823,6 +3212,41 @@ starts. The following environment variables are supported by this module:
Controls whether to output verbose debugging messages in Test::Nginx. Default to empty.
+=head2 TEST_NGINX_BENCHMARK
+
+When set to an non-empty and non-zero value, then the test scaffold enters the benchmarking testing mode by invoking C<weighttp> (for HTTP 1.1 requests) and C<ab> (for HTTP 1.0 requests)
+to run each test case with the test request repeatedly.
+
+When specifying a positive number as the value, then this number is used for the total number of repeated requests. For example,
+
+ export TEST_NGINX_BENCHMARK=1000
+
+will result in 1000 repeated requests for each test block. Default to C<100000>.
+
+When a second number is specified (separated from the first number by spaces), then this second number is used for the concurrency level for the benchmark. For example,
+
+ export TEST_NGINX_BENCHMARK='1000 10'
+
+will result in 1000 repeated requests over 10 concurrent connections for each test block. The default concurrency level is 2 (or 1 if the number of requests is 1).
+
+The "benchmark" testing mode will also output to stderr the actual "ab" or "weighttp" command line used by the test scaffold. For example,
+
+ weighttp -c2 -k -n2000 -H 'Host: foo.com' http://127.0.0.1:1984/t
+
+See also the C<TEST_NGINX_BENCHMARK_WARMUP> environment.
+
+This testing mode requires the C<unbuffer> command-line utility from the C<expect> package.
+
+=head2 TEST_NGINX_BENCHMARK_WARMUP
+
+Specify the number of "warm-up" requests performed before the actual benchmark requests for each test block.
+
+The latencies of the warm-up requests never get included in the final benchmark results.
+
+Only meaningful in the "benchmark" testing mode.
+
+See also the C<TEST_NGINX_BENCHMARK> environment.
+
=head2 TEST_NGINX_CHECK_LEAK
When set to 1, the test scaffold performs the most general memory
@@ -2887,8 +3311,8 @@ Test blocks carrying the "--- no_check_leak" directive will be skipped in this t
When set to 1, the test scaffold will try to send C<HUP> signal to the
Nginx master process to reload the config file between
successive test blocks (but not successive C<repeast_each>
-sub-tests within the same test block). When this envirnoment is set
-to 1, it will also enfornce the "master_process on" config line
+sub-tests within the same test block). When this environment is set
+to 1, it will also enforce the "master_process on" config line
in the F<nginx.conf> file,
because Nginx is buggy in processing HUP signal when the master process is off.
@@ -2916,7 +3340,7 @@ against an already configured (and running) nginx server.
=head2 TEST_NGINX_NO_SHUFFLE
-Dafaults to 0. If set to 1, will make sure the tests are run in the order
+Defaults to 0. If set to 1, will make sure the tests are run in the order
they appear in the test file (and not in random order).
=head2 TEST_NGINX_USE_VALGRIND
@@ -2970,7 +3394,7 @@ then C<1984> is used. See below for typical use.
=head2 TEST_NGINX_CLIENT_PORT
-Value of the port Test::Nginx will diirect requests to. If not
+Value of the port Test::Nginx will direct requests to. If not
set, C<TEST_NGINX_PORT> is used. If C<TEST_NGINX_PORT> is not set,
then C<1984> is used. A typical use of this feature is to test extreme
network conditions by adding a "proxy" between Test::Nginx and nginx
@@ -3102,7 +3526,17 @@ If you want a commit bit, feel free to drop me a line.
=head1 DEBIAN PACKAGES
António P. P. Almeida is maintaining a Debian package for this module
-in his Debian repository: http://debian.perusio.net
+in his Debian repository: L<http://debian.perusio.net>
+
+=head1 Community
+
+=head2 English Mailing List
+
+The C<openresty-en> mailing list is for English speakers: L<https://groups.google.com/group/openresty-en>
+
+=head2 Chinese Mailing List
+
+The C<openresty> mailing list is for Chinese speakers: L<https://groups.google.com/group/openresty>
=head1 AUTHORS
@@ -3,7 +3,7 @@ package Test::Nginx::Util;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use base 'Exporter';
@@ -16,6 +16,7 @@ use Time::HiRes qw( sleep );
use File::Path qw(make_path);
use File::Find qw(find);
use File::Temp qw( tempfile :POSIX );
+use Scalar::Util qw( looks_like_number );
use IO::Socket::INET;
use IO::Socket::UNIX;
use Test::LongString;
@@ -55,6 +56,10 @@ our $Timeout = $ENV{TEST_NGINX_TIMEOUT} || 3;
our $CheckLeak = $ENV{TEST_NGINX_CHECK_LEAK} || 0;
+our $Benchmark = $ENV{TEST_NGINX_BENCHMARK} || 0;
+
+our $BenchmarkWarmup = $ENV{TEST_NGINX_BENCHMARK_WARMUP} || 0;
+
our $CheckAccumErrLog = $ENV{TEST_NGINX_CHECK_ACCUM_ERR_LOG};
our $ServerAddr = '127.0.0.1';
@@ -68,6 +73,32 @@ our @RandStrAlphabet = ('A' .. 'Z', 'a' .. 'z', '0' .. '9',
our $ErrLogFilePos;
+if ($Benchmark) {
+ if ($UseStap) {
+ warn "WARNING: TEST_NGINX_BENCHMARK and TEST_NGINX_USE_STAP "
+ ."are both set and the former wins.\n";
+ undef $UseStap;
+ }
+
+ if ($UseValgrind) {
+ warn "WARNING: TEST_NGINX_BENCHMARK and TEST_NGINX_USE_VALGRIND "
+ ."are both set and the former wins.\n";
+ undef $UseValgrind;
+ }
+
+ if ($UseHup) {
+ warn "WARNING: TEST_NGINX_BENCHMARK and TEST_NGINX_USE_HUP "
+ ."are both set and the former wins.\n";
+ undef $UseHup;
+ }
+
+ if ($CheckLeak) {
+ warn "WARNING: TEST_NGINX_BENCHMARK and TEST_NGINX_CHECK_LEAK "
+ ."are both set and the former wins.\n";
+ undef $CheckLeak;
+ }
+}
+
if ($CheckLeak) {
if ($UseStap) {
warn "WARNING: TEST_NGINX_CHECK_LEAK and TEST_NGINX_USE_STAP "
@@ -128,6 +159,20 @@ sub no_long_string () {
$NoLongString = 1;
}
+sub is_str (@) {
+ my ($got, $expected, $desc) = @_;
+
+ if (ref $expected && ref $expected eq 'Regexp') {
+ return Test::More::like($got, $expected, $desc);
+ }
+
+ if ($NoLongString) {
+ return Test::More::is($got, $expected, $desc);
+ }
+
+ return is_string($got, $expected, $desc);
+}
+
sub server_addr (@) {
if (@_) {
@@ -173,6 +218,9 @@ sub no_nginx_manager () {
$NoNginxManager = 1;
}
+our @CleanupHandlers;
+our @BlockPreprocessors;
+
sub bail_out (@);
our $NginxBinary = $ENV{TEST_NGINX_BINARY} || 'nginx';
@@ -219,7 +267,7 @@ sub server_port_for_client (@) {
sub repeat_each (@) {
if (@_) {
- if ($CheckLeak) {
+ if ($CheckLeak || $Benchmark) {
return;
}
$RepeatEach = shift;
@@ -284,7 +332,8 @@ sub master_process_enabled (@) {
}
}
-our @EXPORT_OK = qw(
+our @EXPORT = qw(
+ is_str
check_accum_error_log
is_running
$NoLongString
@@ -300,6 +349,7 @@ our @EXPORT_OK = qw(
stap_out_fh
stap_out_fname
bail_out
+ add_cleanup_handler
error_log_data
setup_server_root
write_config_file
@@ -317,10 +367,14 @@ our @EXPORT_OK = qw(
$ServRoot
$ConfFile
$RunTestHelper
+ $CheckErrorLog
$FilterHttpConfig
$NoNginxManager
$RepeatEach
$CheckLeak
+ $Benchmark
+ $BenchmarkWarmup
+ add_block_preprocessor
timeout
worker_connections
workers
@@ -352,11 +406,16 @@ sub config_preamble ($) {
}
our $RunTestHelper;
+our $CheckErrorLog;
our $NginxVersion;
our $NginxRawVersion;
our $TODO;
+sub add_block_preprocessor(&) {
+ unshift @BlockPreprocessors, shift;
+}
+
#our ($PrevRequest)
our $PrevConfig;
@@ -393,6 +452,10 @@ sub server_root () {
return $ServRoot;
}
+sub add_cleanup_handler ($) {
+ unshift @CleanupHandlers, shift;
+}
+
sub bail_out (@) {
cleanup();
Test::More::BAIL_OUT(@_);
@@ -462,6 +525,10 @@ sub kill_process ($$) {
}
sub cleanup () {
+ for my $hdl (@CleanupHandlers) {
+ $hdl->();
+ }
+
if (defined $UdpServerPid) {
kill_process($UdpServerPid, 1);
undef $UdpServerPid;
@@ -479,7 +546,7 @@ sub cleanup () {
}
sub error_log_data () {
- # this is for logging in the log-phase which is after the serser closes the connection:
+ # this is for logging in the log-phase which is after the server closes the connection:
sleep $TestNginxSleep * 3;
open my $in, $ErrLogFile or
@@ -511,6 +578,9 @@ sub run_tests () {
}
for my $block ($NoShuffle ? Test::Base::blocks() : shuffle Test::Base::blocks()) {
+ for my $hdl (@BlockPreprocessors) {
+ $block = $hdl->($block);
+ }
run_test($block);
}
@@ -591,32 +661,39 @@ sub write_user_files ($) {
my $name = $block->name;
- if ($block->user_files) {
- my $raw = $block->user_files;
+ my $files = $block->user_files;
+ if ($files) {
+ if (!ref $files) {
+ my $raw = $files;
- open my $in, '<', \$raw;
+ open my $in, '<', \$raw;
- my @files;
- my ($fname, $body, $date);
- while (<$in>) {
- if (/>>> (\S+)(?:\s+(.+))?/) {
- if ($fname) {
- push @files, [$fname, $body, $date];
+ $files = [];
+ my ($fname, $body, $date);
+ while (<$in>) {
+ if (/>>> (\S+)(?:\s+(.+))?/) {
+ if ($fname) {
+ push @$files, [$fname, $body, $date];
+ }
+
+ $fname = $1;
+ $date = $2;
+ undef $body;
+ } else {
+ $body .= $_;
}
+ }
- $fname = $1;
- $date = $2;
- undef $body;
- } else {
- $body .= $_;
+ if ($fname) {
+ push @$files, [$fname, $body, $date];
}
- }
- if ($fname) {
- push @files, [$fname, $body, $date];
+ } elsif (ref $files ne 'ARRAY') {
+ bail_out "$name - wrong value type: ", ref $files,
+ ", only scalar or ARRAY are accepted";
}
- for my $file (@files) {
+ for my $file (@$files) {
my ($fname, $body, $date) = @$file;
#warn "write file $fname with content [$body]\n";
@@ -641,6 +718,8 @@ sub write_user_files ($) {
open my $out, ">$path" or
bail_out "$name - Cannot open $path for writing: $!\n";
+ binmode $out;
+ #warn "write file $path with data len ", length $body;
print $out $body;
close $out;
@@ -653,8 +732,14 @@ sub write_user_files ($) {
}
}
-sub write_config_file ($$$$) {
- my ($config, $http_config, $main_config, $post_main_config) = @_;
+sub write_config_file ($$) {
+ my ($block, $config) = @_;
+
+ my $http_config = $block->http_config;
+ my $main_config = $block->main_config;
+ my $post_main_config = $block->post_main_config;
+ my $err_log_file = $block->error_log_file;
+ my $server_name = $block->server_name;
if ($UseHup) {
master_on(); # config reload is buggy when master is off
@@ -696,18 +781,29 @@ sub write_config_file ($$$$) {
$post_main_config = '';
}
- if ($CheckLeak) {
+ if ($CheckLeak || $Benchmark) {
$LogLevel = 'warn';
$AccLogFile = 'off';
}
+ if (!$err_log_file) {
+ $err_log_file = $ErrLogFile;
+ }
+
+ if (!defined $server_name) {
+ $server_name = $ServerName;
+ }
+
+ (my $quoted_server_name = $server_name) =~ s/\\/\\\\/g;
+ $quoted_server_name =~ s/'/\\'/g;
+
open my $out, ">$ConfFile" or
bail_out "Can't open $ConfFile for writing: $!\n";
print $out <<_EOC_;
worker_processes $Workers;
daemon $DaemonEnabled;
master_process $MasterProcessEnabled;
-error_log $ErrLogFile $LogLevel;
+error_log $err_log_file $LogLevel;
pid $PidFile;
env MOCKEAGAIN_VERBOSE;
env MOCKEAGAIN;
@@ -731,7 +827,7 @@ $http_config
server {
listen $ServerPort;
- server_name '$ServerName';
+ server_name '$server_name';
client_max_body_size 30M;
#client_body_buffer_size 4k;
@@ -778,7 +874,7 @@ $post_main_config
#timer_resolution 100ms;
events {
- #accept_mutex off;
+ accept_mutex off;
worker_connections $WorkerConnections;
_EOC_
@@ -954,6 +1050,53 @@ sub check_if_missing_directives () {
return 0;
}
+sub run_tcp_server_tests ($$$) {
+ my ($block, $tcp_socket, $tcp_query_file) = @_;
+
+ my $name = $block->name;
+
+ if (defined $tcp_socket) {
+ my $buf = '';
+ if ($tcp_query_file) {
+ if (open my $in, $tcp_query_file) {
+ $buf = do { local $/; <$in> };
+ close $in;
+ }
+ }
+
+ if (defined $block->tcp_query) {
+ is_str($buf, $block->tcp_query, "$name - tcp_query ok");
+ }
+
+ if (defined $block->tcp_query_len) {
+ Test::More::is(length($buf), $block->tcp_query_len, "$name - TCP query length ok");
+ }
+ }
+}
+
+sub run_udp_server_tests ($$$) {
+ my ($block, $udp_socket, $udp_query_file) = @_;
+
+ my $name = $block->name;
+
+ if (defined $udp_socket) {
+ my $buf = '';
+ if ($udp_query_file) {
+ if (!open my $in, $udp_query_file) {
+ warn "WARNING: cannot open udp query file $udp_query_file for reading: $!\n";
+
+ } else {
+ $buf = do { local $/; <$in> };
+ close $in;
+ }
+ }
+
+ if (defined $block->udp_query) {
+ is_str($buf, $block->udp_query, "$name - udp_query ok");
+ }
+ }
+}
+
sub run_test ($) {
my $block = shift;
my $name = $block->name;
@@ -980,6 +1123,35 @@ sub run_test ($) {
$LogLevel = $block->log_level;
}
+ my $must_die;
+ local $UseStap = $UseStap;
+ local $UseValgrind = $UseValgrind;
+ local $UseHup = $UseHup;
+ local $Profiling = $Profiling;
+
+ if (defined $block->must_die) {
+ $must_die = $block->must_die;
+ if (defined $block->stap) {
+ bail_out("$name: --- stap cannot be used with --- must_die");
+ }
+
+ if ($UseStap) {
+ undef $UseStap;
+ }
+
+ if ($UseValgrind) {
+ undef $UseValgrind;
+ }
+
+ if ($UseHup) {
+ undef $UseHup;
+ }
+
+ if ($Profiling) {
+ undef $Profiling;
+ }
+ }
+
if (!defined $config) {
if (!$NoNginxManager) {
# Manager without config.
@@ -1025,7 +1197,7 @@ sub run_test ($) {
my $skip_slave = $block->skip_slave;
my ($tests_to_skip, $should_skip, $skip_reason);
- if ($CheckLeak && defined $block->no_check_leak) {
+ if (($CheckLeak || $Benchmark) && defined $block->no_check_leak) {
$should_skip = 1;
}
@@ -1054,6 +1226,9 @@ sub run_test ($) {
$tests_to_skip = $1;
my ($op, $ver1, $ver2, $ver3) = ($2, $3, $4, $5);
$skip_reason = $6;
+ if (!$skip_reason) {
+ $skip_reason = "nginx version $op $ver1.$ver2.$ver3";
+ }
#warn "$ver1 $ver2 $ver3";
my $ver = get_canon_version($ver1, $ver2, $ver3);
if ((!defined $NginxVersion and $op =~ /^</)
@@ -1212,9 +1387,7 @@ sub run_test ($) {
setup_server_root();
write_user_files($block);
- write_config_file($config, $block->http_config,
- $block->main_config,
- $block->post_main_config);
+ write_config_file($block, $config);
if ($Verbose) {
warn "sending USR1 signal to $pid.\n";
@@ -1301,8 +1474,7 @@ start_nginx:
#warn "*** Restarting the nginx server...\n";
setup_server_root();
write_user_files($block);
- write_config_file($config, $block->http_config,
- $block->main_config, $block->post_main_config);
+ write_config_file($block, $config);
#warn "nginx binary: $NginxBinary";
if (!can_run($NginxBinary)) {
bail_out("$name - Cannot find the nginx executable in the PATH environment");
@@ -1353,16 +1525,21 @@ start_nginx:
}
if ($block->stap) {
- my ($stap_fh, $stap_fname) = tempfile("XXXXXXX", SUFFIX => '.stp', TMPDIR => 1);
+ my ($stap_fh, $stap_fname) = tempfile("XXXXXXX",
+ SUFFIX => '.stp',
+ TMPDIR => 1,
+ UNLINK => 1);
my $stap = $block->stap;
- if ($stap =~ /\$LIBLUA_PATH\b/) {
+ if ($stap =~ /\$LIB([_A-Z0-9]+)_PATH\b/) {
+ my $name = $1;
+ my $libname = 'lib' . lc($name);
my $nginx_path = can_run($NginxBinary);
#warn "nginx path: ", $nginx_path;
- my $line = `ldd $nginx_path|grep -E 'liblua.*?\.so'`;
- warn "line: $line";
+ my $line = `ldd $nginx_path|grep -E '$libname.*?\.so'`;
+ #warn "line: $line";
my $liblua_path;
- if ($line =~ m{\S+/liblua.*?\.so(?:\.\d+)*}) {
+ if ($line =~ m{\S+/$libname.*?\.so(?:\.\d+)*}) {
$liblua_path = $&;
} else {
@@ -1370,23 +1547,7 @@ start_nginx:
$liblua_path = $nginx_path;
}
- $stap =~ s/\$LIBLUA_PATH\b/$liblua_path/g;
- }
-
- if ($stap =~ /\$LIBPCRE_PATH\b/) {
- my $nginx_path = can_run($NginxBinary);
- #warn "nginx path: ", $nginx_path;
- my $line = `ldd $nginx_path|grep libpcre.so`;
- my $libpcre_path;
- if ($line =~ m{\S+/libpcre\.so(?:\.\d+)*}) {
- $libpcre_path = $&;
-
- } else {
- # static linking is used?
- $libpcre_path = $nginx_path;
- }
-
- $stap =~ s/\$LIBPCRE_PATH\b/$libpcre_path/g;
+ $stap =~ s/\$LIB${name}_PATH\b/$liblua_path/gi;
}
$stap =~ s/^\bS\(([^)]+)\)/probe process("nginx").statement("*\@$1")/smg;
@@ -1406,7 +1567,10 @@ start_nginx:
}
if (!$StapOutFile) {
- ($out, $outfile) = tempfile("XXXXXXXX", SUFFIX => '.stp-out', TMPDIR => 1);
+ ($out, $outfile) = tempfile("XXXXXXXX",
+ SUFFIX => '.stp-out',
+ TMPDIR => 1,
+ UNLINK => 1);
close $out;
$StapOutFile = $outfile;
@@ -1466,7 +1630,51 @@ start_nginx:
sleep $TestNginxSleep;
} else {
- if (system($cmd) != 0) {
+ my $i = 0;
+ $ErrLogFilePos = 0;
+ my ($exec_failed, $coredump, $exit_code);
+
+RUN_AGAIN:
+ system($cmd);
+
+ if ($? == -1) {
+ $exec_failed = 1;
+
+ } else {
+ $exit_code = $? >> 8;
+
+ if ($? > (128 << 8)) {
+ $coredump = ($exit_code & 128);
+ $exit_code = ($exit_code >> 8);
+
+ } else {
+ $coredump = ($? & 128);
+ }
+ }
+
+ if (defined $must_die) {
+ # Always should be able to execute
+ if ($exec_failed) {
+ Test::More::fail("$name - failed to execute the nginx command line")
+
+ } elsif ($coredump) {
+ Test::More::fail("$name - nginx core dumped")
+
+ } elsif (looks_like_number($must_die)) {
+ Test::More::is($must_die, $exit_code,
+ "$name - die with the expected exit code")
+
+ } else {
+ Test::More::isnt($?, 0, "$name - die as expected")
+ }
+
+ $CheckErrorLog->($block, undef, $dry_run, $i, 0);
+
+ goto RUN_AGAIN if ++$i < $RepeatEach;
+ return;
+ }
+
+ if ($? != 0) {
if ($ENV{TEST_NGINX_IGNORE_MISSING_DIRECTIVES} and
my $directive = check_if_missing_directives())
{
@@ -1504,7 +1712,7 @@ request:
warn "Run the test block...\n";
}
- if ($CheckLeak && defined $block->tcp_listen) {
+ if (($CheckLeak || $Benchmark) && defined $block->tcp_listen) {
my $n = defined($block->tcp_query_len) ? 1 : 0;
$n += defined($block->tcp_query) ? 1 : 0;
@@ -1518,18 +1726,21 @@ request:
}
my ($tcp_socket, $tcp_query_file);
- if (!$CheckLeak && defined $block->tcp_listen) {
+ if (!($CheckLeak || $Benchmark) && defined $block->tcp_listen) {
my $target = $block->tcp_listen;
my $reply = $block->tcp_reply;
- if (!defined $reply) {
+ if (!defined $reply && !defined $block->tcp_shutdown) {
bail_out("$name - no --- tcp_reply specified but --- tcp_listen is specified");
}
my $req_len = $block->tcp_query_len;
if (defined $block->tcp_query || defined $req_len) {
+ if (!defined $req_len) {
+ $req_len = length($block->tcp_query);
+ }
$tcp_query_file = tmpnam();
}
@@ -1627,32 +1838,69 @@ request:
sleep $TestNginxSleep;
}
- my $buf;
-
- while (1) {
- my $b;
- my $ret = $client->recv($b, 4096);
- if (!defined $ret) {
- die "failed to receive: $!\n";
+ my ($no_read, $no_write);
+ if (defined $block->tcp_shutdown) {
+ my $shutdown = $block->tcp_shutdown;
+ if ($block->tcp_shutdown_delay) {
+ sleep $block->tcp_shutdown_delay;
}
+ $client->shutdown($shutdown);
+ if ($shutdown == 0 || $shutdown == 2) {
+ if ($Verbose) {
+ warn "tcp server shutdown the read part.\n";
+ }
+ $no_read = 1;
- $buf .= $b;
-
- if (!$req_len || length($buf) >= $req_len) {
- last;
+ } else {
+ if ($Verbose) {
+ warn "tcp server shutdown the write part.\n";
+ }
+ $no_write = 1;
}
}
- if ($tcp_query_file) {
- open my $out, ">$tcp_query_file"
- or die "cannot open $tcp_query_file for writing: $!\n";
-
+ unless ($no_read) {
if ($Verbose) {
- warn "writing received data [$buf] to file $tcp_query_file\n";
+ warn "TCP server reading request...\n";
}
- print $out $buf;
- close $out;
+ my $buf;
+
+ while (1) {
+ my $b;
+ my $ret = $client->recv($b, 4096);
+ if (!defined $ret) {
+ die "failed to receive: $!\n";
+ }
+
+ if ($Verbose) {
+ #warn "TCP server read data: [", $b, "]\n";
+ }
+
+ $buf .= $b;
+
+
+ # flush read data to the file as soon as possible:
+
+ if ($tcp_query_file) {
+ open my $out, ">$tcp_query_file"
+ or die "cannot open $tcp_query_file for writing: $!\n";
+
+ if ($Verbose) {
+ warn "writing received data [$buf] to file $tcp_query_file\n";
+ }
+
+ print $out $buf;
+ close $out;
+ }
+
+ if (!$req_len || length($buf) >= $req_len) {
+ if ($Verbose) {
+ warn "len: ", length($buf), ", req len: $req_len\n";
+ }
+ last;
+ }
+ }
}
my $delay = parse_time($block->tcp_reply_delay);
@@ -1663,21 +1911,29 @@ request:
sleep $delay;
}
- if (defined $reply) {
- if (ref $reply) {
- for my $r (@$reply) {
- #warn "sending reply $r";
- my $bytes = $client->send($r);
+ unless ($no_write) {
+ if (defined $reply) {
+ if ($Verbose) {
+ warn "TCP server writing reply...\n";
+ }
+
+ if (ref $reply) {
+ for my $r (@$reply) {
+ if ($Verbose) {
+ warn "sending reply $r";
+ }
+ my $bytes = $client->send($r);
+ if (!defined $bytes) {
+ warn "WARNING: tcp server failed to send reply: $!\n";
+ }
+ }
+
+ } else {
+ my $bytes = $client->send($reply);
if (!defined $bytes) {
warn "WARNING: tcp server failed to send reply: $!\n";
}
}
-
- } else {
- my $bytes = $client->send($reply);
- if (!defined $bytes) {
- warn "WARNING: tcp server failed to send reply: $!\n";
- }
}
}
@@ -1706,7 +1962,7 @@ request:
}
}
- if ($CheckLeak && defined $block->udp_listen) {
+ if (($CheckLeak || $Benchmark) && defined $block->udp_listen) {
my $n = defined($block->udp_query) ? 1 : 0;
@@ -1719,7 +1975,7 @@ request:
}
my ($udp_socket, $uds_socket_file, $udp_query_file);
- if (!$CheckLeak && defined $block->udp_listen) {
+ if (!($CheckLeak || $Benchmark) && defined $block->udp_listen) {
my $reply = $block->udp_reply;
if (!defined $reply) {
bail_out("$name - no --- udp_reply specified but --- udp_listen is specified");
@@ -1781,9 +2037,17 @@ request:
local $| = 1;
- my $buf;
+ if ($Verbose) {
+ warn "UDP server reading data...\n";
+ }
+
+ my $buf = '';
$udp_socket->recv($buf, 4096);
+ if ($Verbose) {
+ warn "UDP server has got data: ", length $buf, "\n";
+ }
+
if ($udp_query_file) {
open my $out, ">$udp_query_file"
or die "cannot open $udp_query_file for writing: $!\n";
@@ -1805,7 +2069,17 @@ request:
}
if (defined $reply) {
- if (ref $reply) {
+ my $ref = ref $reply;
+ if ($ref && $ref eq 'CODE') {
+ $reply = $reply->($buf);
+ $ref = ref $reply;
+ }
+
+ if ($ref) {
+ if ($ref ne 'ARRAY') {
+ bail_out("bad --- udp_reply value");
+ }
+
for my $r (@$reply) {
#warn "sending reply $r";
my $bytes = $udp_socket->send($r);
@@ -1847,6 +2121,8 @@ request:
Test::More::skip("$name - $skip_reason", $tests_to_skip);
$RunTestHelper->($block, $dry_run, $i - 1);
+ run_tcp_server_tests($block, $tcp_socket, $tcp_query_file);
+ run_udp_server_tests($block, $udp_socket, $udp_query_file);
}
} elsif ($should_todo) {
@@ -1854,32 +2130,17 @@ request:
local $TODO = "$name - $todo_reason";
$RunTestHelper->($block, $dry_run, $i - 1);
+ run_tcp_server_tests($block, $tcp_socket, $tcp_query_file);
+ run_udp_server_tests($block, $udp_socket, $udp_query_file);
}
} else {
$RunTestHelper->($block, $dry_run, $i - 1);
+ run_tcp_server_tests($block, $tcp_socket, $tcp_query_file);
+ run_udp_server_tests($block, $udp_socket, $udp_query_file);
}
if (defined $udp_socket) {
- my $buf = '';
- if ($udp_query_file) {
- if (!open my $in, $udp_query_file) {
- warn "WARNING: cannot open tcp query file $udp_query_file for reading: $!\n";
-
- } else {
- $buf = do { local $/; <$in> };
- close $in;
- }
- }
-
- if (defined $block->udp_query) {
- if ($NoLongString) {
- Test::More::is($buf, $block->udp_query, "$name - udp_query ok");
- } else {
- is_string $buf, $block->udp_query, "$name - udp_query ok";
- }
- }
-
if (defined $UdpServerPid) {
kill_process($UdpServerPid, 1);
undef $UdpServerPid;
@@ -1895,29 +2156,6 @@ request:
}
if (defined $tcp_socket) {
- my $buf = '';
- if ($tcp_query_file) {
- if (!open my $in, $tcp_query_file) {
- warn "WARNING: cannot open tcp query file $tcp_query_file for reading: $!\n";
-
- } else {
- $buf = do { local $/; <$in> };
- close $in;
- }
- }
-
- if (defined $block->tcp_query) {
- if ($NoLongString) {
- Test::More::is($buf, $block->tcp_query, "$name - tcp_query ok");
- } else {
- is_string $buf, $block->tcp_query, "$name - tcp_query ok";
- }
- }
-
- if (defined $block->tcp_query_len) {
- Test::More::is(length($buf), $block->tcp_query_len, "$name - TCP query length ok");
- }
-
if (defined $TcpServerPid) {
if ($Verbose) {
warn "killing TCP server, pid $TcpServerPid\n";
@@ -1960,9 +2198,7 @@ request:
my $i = 0;
retry:
if (is_running($pid)) {
- write_config_file($config, $block->http_config,
- $block->main_config,
- $block->post_main_config);
+ write_config_file($block, $config);
if ($Verbose) {
warn "sending QUIT signal to $pid";
@@ -3,7 +3,7 @@ package Test::Nginx;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
__END__
@@ -11,7 +11,7 @@ __END__
=head1 NAME
-Test::Nginx - Testing modules for Nginx C module development
+Test::Nginx - Data-driven test scaffold for Nginx C module and OpenResty Lua library development
=head1 DESCRIPTION
@@ -153,7 +153,7 @@ stdout/stderr.
Test::Nginx has integrated support for valgrind (L<http://valgrind.org>) even though by
default it does not bother running it with the tests because valgrind
-will significantly slow down the test sutie.
+will significantly slow down the test suite.
First ensure that your valgrind executable visible in your PATH env.
And then run your test suite with the C<TEST_NGINX_USE_VALGRIND> env set
@@ -285,17 +285,27 @@ If you want a commit bit, feel free to drop me a line.
=head1 DEBIAN PACKAGES
António P. P. Almeida is maintaining a Debian package for this module
-in his Debian repository: http://debian.perusio.net
+in his Debian repository: L<http://debian.perusio.net>
+
+=head1 Community
+
+=head2 English Mailing List
+
+The C<openresty-en> mailing list is for English speakers: L<https://groups.google.com/group/openresty-en>
+
+=head2 Chinese Mailing List
+
+The C<openresty> mailing list is for Chinese speakers: L<https://groups.google.com/group/openresty>
=head1 AUTHORS
-agentzh (章亦春) C<< <agentzh@gmail.com> >>
+Yichun Zhang (agentzh) C<< <agentzh@gmail.com> >>
Antoine BONAVITA C<< <antoine.bonavita@gmail.com> >>
=head1 COPYRIGHT & LICENSE
-Copyright (c) 2009-2012, agentzh C<< <agentzh@gmail.com> >>.
+Copyright (c) 2009-2014, Yichun Zhang (agentzh) C<< <agentzh@gmail.com> >>.
Copyright (c) 2011-2012, Antoine Bonavita C<< <antoine.bonavita@gmail.com> >>.
@@ -1,4 +1,5 @@
# Unit tests for Test::Nginx::Socket::get_req_from_block
+use lib 'lib';
use Test::Nginx::Socket tests => 1;
my @block_list = blocks();
@@ -10,7 +11,7 @@ my $i = 0; # Use $i to make copy/paste of tests easier.
my $html = "<html><head><title>Google</title></head><body>Search me...</body></html>";
my $raw_res="HTTP/1.0 200 OK\r\nDate: Fri, 31 Dec 1999 23:59:59 GMT\r\nContent-Type: text/html\r\nContent-Length: ".length($html)."\r\n\r\n".$html;
my ( $res, $raw_headers, $left ) = Test::Nginx::Socket::parse_response("name", $raw_res, 0);
-Test::Nginx::Socket::check_response_body($block_list[$i], $res, undef, 0, 0);
+Test::Nginx::Socket::check_response_body($block_list[$i], $res, undef, 0, 0, 0);
__DATA__
@@ -1,13 +1,14 @@
# Unit tests for Test::Nginx::Socket::get_req_from_block
+use lib 'lib';
use Test::Nginx::Socket tests => 7;
my @block_list = blocks();
my $i = 0; # Use $i to make copy/paste of tests easier.
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
- [[{value => "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: Close\r\n\r\n"}]],
+ [[{value => "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"}]],
$block_list[$i++]->name);
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
- [[{value => "POST /rrd/taratata HTTP/1.1\r\nHost: localhost\r\nConnection: Close"
+ [[{value => "POST /rrd/taratata HTTP/1.1\r\nHost: localhost\r\nConnection: close"
."\r\nContent-Length: 15\r\n\r\nvalue=N%3A12345"}]],
$block_list[$i++]->name);
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
@@ -17,7 +18,7 @@ is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
[[{ value => "POST /foo HTTP/1.1\r
Host: localhost\r
-Connection: Close\r
+Connection: close\r
Content-Type: application/x-www-form-urlencoded\r
Content-Length:3\r\n\r\nA"}, {value =>"B"},
{value =>"C"}]],
@@ -27,15 +28,15 @@ is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
"noheader\r\n\r\nrub my face in the dirt"}]],
$block_list[$i++]->name);
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
- [[{value =>"POST /foo HTTP/1.1\r\nHost: localhost\r\nConnection: Close\r\nContent-Length: 15\r\n\r\nv"},
+ [[{value =>"POST /foo HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\nContent-Length: 15\r\n\r\nv"},
{value =>"alue=N%3A12345"}],
- [{value =>"GET /foo HTTP/1.1\r\nHost: localhost\r\nConnection: Close\r\n\r\n"}]],
+ [{value =>"GET /foo HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"}]],
$block_list[$i++]->name);
is_deeply(Test::Nginx::Socket::get_req_from_block($block_list[$i]),
- [[{value =>"POST /foo HTTP/1.1\r\nHost: localhost\r\nConnection: Close\r\nContent-Length: 15\r\n\r\n"},
+ [[{value =>"POST /foo HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\nContent-Length: 15\r\n\r\n"},
{value =>"value=N%3A12345", delay_before => 3}],
[{value =>"GET "},
- {value =>"/foo HTTP/1.1\r\nHost: localhost\r\nConnection: Close\r\n\r\n"}]],
+ {value =>"/foo HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"}]],
$block_list[$i++]->name);
__DATA__
@@ -54,7 +55,7 @@ value=".uri_escape("N:12345")
--- raw_request eval
["POST /foo HTTP/1.1\r
Host: localhost\r
-Connection: Close\r
+Connection: close\r
Content-Type: application/x-www-form-urlencoded\r
Content-Length:3\r\n\r\nA",
"B",