X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/3635c4ef0b6ceb2d7e95e66adbac3a8b66066521..9038784fd549da6452ab9491eae5d3fd5dd9fa42:/t/50-cgi.t diff --git a/t/50-cgi.t b/t/50-cgi.t index d04e450..d6c2856 100644 --- a/t/50-cgi.t +++ b/t/50-cgi.t @@ -1,9 +1,24 @@ use strict; use warnings; +use Cwd; use File::Spec; use Test::More; +eval { + require Test::LongString; + Test::LongString->import(max => 128); + + no warnings 'redefine'; # override module to not escape newlines + my $formatter = *Test::LongString::_display; + my $parent = \&{$formatter}; + *{$formatter} = sub { + my $s = &{$parent}; + $s =~ s/\Q\x{0a}/\n /g; # revert newline quoting + return $s; + }; +} or *is_string = \&is; # fallback to ugly unformatted is() + eval { require PerlIO::scalar }; plan skip_all => "PerlIO required (perl 5.8) to test PLP" if $@; @@ -14,7 +29,7 @@ require_ok('PLP::Backend::CGI') or BAIL_OUT(); $PLP::use_cache = 0 if $PLP::use_cache; #TODO: caching on (change file names) -my $base = File::Spec->tmpdir || File::Spec->curdir; +my $base = Cwd::abs_path(File::Spec->tmpdir || File::Spec->curdir); -w $base or BAIL_OUT("$base not writable"); my $testfile = 'testfile.plp'; not -f "$base/$testfile" or BAIL_OUT("$testfile exists"); @@ -22,10 +37,25 @@ not -f "$base/$testfile" or BAIL_OUT("$testfile exists"); open ORGOUT, '>&', *STDOUT; sub plp_is { - my ($test, $plp, $expect) = @_; + my ($test, $plp, $expect, $env) = @_; chomp $expect; local $Test::Builder::Level = $Test::Builder::Level + 1; + %ENV = ( + REQUEST_METHOD => 'GET', + REQUEST_URI => "/$testfile/test/123", + QUERY_STRING => 'test=1&test=2', + GATEWAY_INTERFACE => 'CGI/1.1', + + SCRIPT_NAME => '/plp.cgi', + SCRIPT_FILENAME => "$base/plp.cgi", + PATH_INFO => "/$testfile/test/123", + PATH_TRANSLATED => "$base/$testfile/test/123", + DOCUMENT_ROOT => $base, + + $env ? %{$env} : (), + ); # Apache/2.2.4 CGI environment + if (defined $plp) { eval { open my $testfh, '>', "$base/$testfile" or die $!; @@ -37,29 +67,39 @@ sub plp_is { close STDOUT; open STDOUT, '>', \my $output; # STDOUT buffered to scalar + select STDOUT; # output before start() (which selects PLPOUT) eval { - local $SIG{__WARN__} = sub { print $_[0] }; # enables warnings + local $SIG{__WARN__} = sub { + # include warnings in stdout (but modified to distinguish) + my $msg = shift; + my $eol = $msg =~ s/(\s*\z)// && $1; + print "$msg$eol" + }; PLP::everything(); }; + my $failure = $@; select ORGOUT; # return to original STDOUT - not $@ or fail($test), diag(" Error: $@"), return; + if ($failure) { + fail($test); + diag(" Error: $failure"); + return; + } $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers - is($output, $expect, $test); + is_string($output, $expect, $test); } -%ENV = ( - REQUEST_METHOD => 'GET', - REQUEST_URI => "/$testfile/test/123", - QUERY_STRING => 'test=1&test=2', - GATEWAY_INTERFACE => 'CGI/1.1', - - SCRIPT_NAME => '/plp.cgi', - SCRIPT_FILENAME => "$base/plp.cgi", - PATH_INFO => "/$testfile/test/123", - PATH_TRANSLATED => "$base/$testfile/test/123", - DOCUMENT_ROOT => $base, -); # Apache/2.2.4 CGI environment +sub getwarning { + # captures the first warning produced by the given code string + my ($code, $line, $file) = @_; + + local $SIG{__WARN__} = sub { die @_ }; + # warnings module runs at BEGIN, so we need to use icky expression evals + eval qq(# line $line "$file"\n$code; return); + my $res = $@; + chomp $res; + return $res; +}; my $HEAD = < <: include '$testfile.inc'", "$HEAD\nok ok"); unlink "$base/$testfile.inc"; +my $SYNTAXERR = getwarning("q\cq\n\cq; syntax(error", 1, $testfile); plp_is('fatal error', "runtime\n<: syntax(error :>\nruntime", <Debug information:
syntax error at $testfile line 2, at EOF - (Might be a runaway multi-line \cq\cq string starting on line 1) +
Debug information:
$SYNTAXERR
TEST @@ -118,33 +158,25 @@ if (open my $dummy, "<", $INCFILE) { # like PLP::source will } my $INCWARN = qq{Can't open "$INCFILE" ($!)}; +my $VOIDWARN = getwarning('42', 2, $testfile); + plp_is('warnings', split /\n\n/, < -2 -<: 42 :> -3 -<: warn "warning" :> -4 -<: include "missinginclude" :> -5 -<(missinginclude)> +1<: use warnings :> +2<: 42 :> +3<: warn "warning" :> +4<: include "missinginclude" :> +5<(missinginclude)> 6 $HEAD -Useless use of a constant in void context at $testfile line 4. +${VOIDWARN} 1 - 2 +3warning at $testfile line 3. -3 -warning at $testfile line 6. - -4 -
Debug information:
$INCWARN at $testfile line 8. +4
Debug information:
$INCWARN at $testfile line 4.
-5 -
Debug information:
$INCWARN at $testfile line 10. +5
Debug information:
$INCWARN at $testfile line 5.
TEST @@ -177,6 +209,7 @@ plp_is('%ENV (on apache)', @envtest); SKIP: { chmod 0244, $testfile or skip("changed permissions", 1); plp_is('permission denied', undef, <PLP: Can't read: $base/$testfile (/$testfile/test/123) Content-Type: text/html Status: 403 @@ -192,8 +225,9 @@ TEST chmod 0644, $testfile; } -$ENV{PATH_TRANSLATED} = "$base/missinginclude/test/123"; -plp_is('not found', undef, < "$base/missinginclude/test/123"); +plp_is('not found', undef, <PLP: Not found: $base/missinginclude/test/123 (/$testfile/test/123) Content-Type: text/html Status: 404 @@ -207,7 +241,8 @@ The requested URL /$testfile/test/123 was not found on this server.

TEST -%ENV = ( +plp_is('%ENV on lighttpd', @envtest, { + # lighttpd/1.4.7 CGI environment REQUEST_METHOD => 'GET', REQUEST_URI => "/$testfile/test/123", QUERY_STRING => 'test=1&test=2', @@ -216,9 +251,9 @@ TEST SCRIPT_NAME => "/$testfile", #XXX: .plp? SCRIPT_FILENAME => "$base/$testfile", PATH_INFO => '/test/123', -); # lighttpd/1.4.7 CGI environment - -plp_is('%ENV on lighttpd', @envtest); + PATH_TRANSLATED => undef, + DOCUMENT_ROOT => undef, +}); unlink "$base/$testfile";