view perl_gzip.t @ 290:f781b087b7aa

Tests: fixed possible test suite hang on exit. In some cases (for example, call of global object method in a function), test suite can hang during exit, because temporary directory holding a pid file is removed prior to executing global test object desctructor. The root cause is that the directory removal occurs in the END block (in the File::Temp package) and the order of executing destructors and END blocks is not specified in Perl. The fix is to remove temporary directory in the test object destructor explicitly and get rid of 'CLEANUP' flag in the tempdir() call. The temporary directory is removed by the means of rmtree() function, called inside an eval block to exclude the case when rmtree may abort (some versions are known to do it).
author Vladimir Homutov <vl@nginx.com>
date Thu, 30 May 2013 07:38:23 +0400
parents 6a0d934950bc
children c877f91a71b4
line wrap: on
line source

#!/usr/bin/perl

# (C) Maxim Dounin

# Tests for embedded perl module.

###############################################################################

use warnings;
use strict;

use Test::More;

BEGIN { use FindBin; chdir($FindBin::Bin); }

use lib 'lib';
use Test::Nginx qw/ :DEFAULT :gzip /;

###############################################################################

select STDERR; $| = 1;
select STDOUT; $| = 1;

eval { require IO::Compress::Gzip; };
Test::More::plan(skip_all => "IO::Compress::Gzip not found") if $@;

my $t = Test::Nginx->new()->has(qw/http perl gzip/)->plan(2)
	->write_file_expand('nginx.conf', <<'EOF');

%%TEST_GLOBALS%%

daemon off;

events {
}

http {
    %%TEST_GLOBALS_HTTP%%

    server {
        listen       127.0.0.1:8080;
        server_name  localhost;

        gzip on;
        gzip_types text/plain;

        location / {
            perl 'sub {
                my $r = shift;
                $r->send_http_header("text/plain");
                return OK if $r->header_only;
                $r->print("TEST");
                return OK;
            }';
        }

        location /gz {
            perl 'sub {
                my $r = shift;
                $r->header_out("Content-Encoding", "gzip");
                $r->send_http_header("text/plain");
                return OK if $r->header_only;
                use IO::Compress::Gzip;
                my $in = "TEST";
                my $out;
                IO::Compress::Gzip::gzip(\\$in => \\$out);
                $r->print($out);
                return OK;
            }';
        }
    }
}

EOF

$t->run();

###############################################################################

http_gzip_like(http_gzip_request('/'), qr/TEST/, 'perl response gzipped');
http_gzip_like(http_gzip_request('/gz'), qr/TEST/, 'not doublegzipped');

###############################################################################