- local $SIG{__WARN__} = sub {
- # include warnings in stdout (but modified to distinguish)
- my $msg = shift;
- my $eol = $msg =~ s/(\s*\z)// && $1;
- print "<warning>$msg</warning>$eol"
- };
- PLP::everything();
- };
- my $failure = $@;
- select ORGOUT; # return to original STDOUT
-
- if ($failure) {
- fail($test);
- diag(" Error: $failure");
- return;
- }
- $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
- is_string($output, $expect, $test);
-}
-
-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 = <<EOT; # common header output
-Content-Type: text/html
-X-PLP-Version: $PLP::VERSION
-EOT
-
-plp_is('print', '0<: print print 2 :>3', "$HEAD\n0213");
-
-plp_is('exit', '1<:exit:>not <(reached)>', "$HEAD\n1");
-
-plp_is('<:=', '1<:=$foo=2:>3<:= $foo', "$HEAD\n1232");
-
-plp_is('%get', '<: print $get{test} if defined $get{test} and not exists $get{test2}', "$HEAD\n2\n");
-
-plp_is('%get array', '<:= @{$get{q/@test/}}', "$HEAD\n12\n");
-
-plp_is('%header',
- '<: $headers{_test}=2; print $header{x_PLP_version}; BEGIN { $header{"-tesT"}=1 }',
- "-tesT: 2\n$HEAD\n$PLP::VERSION"
-);