git.shiar.nl
/
perl
/
plp
/
.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
t: rename abbreviated variables in Test::PLP
[perl/plp/.git]
/
lib
/
Test
/
PLP.pm
diff --git
a/lib/Test/PLP.pm
b/lib/Test/PLP.pm
index edadc874a5ebf3ff3f8992d6a5f47df865e66b07..1eec19b1269bd7b1f2be0f6d174edaf4dbff6daa 100644
(file)
--- a/
lib/Test/PLP.pm
+++ b/
lib/Test/PLP.pm
@@
-3,24
+3,28
@@
package Test::PLP;
use strict;
use warnings;
use strict;
use warnings;
-use Cwd;
-use Test::More;
use PLP::Functions qw( DecodeURI );
require PLP::Backend::CGI;
require PerlIO::scalar;
our $VERSION = '1.00';
use PLP::Functions qw( DecodeURI );
require PLP::Backend::CGI;
require PerlIO::scalar;
our $VERSION = '1.00';
-use base 'Exporter';
+use Test::Builder::Module;
+use base 'Test::Builder::Module';
our @EXPORT = qw( plp_is plp_ok );
$PLP::use_cache = 0 if $PLP::use_cache;
#TODO: caching on (change file names)
our @EXPORT = qw( plp_is plp_ok );
$PLP::use_cache = 0 if $PLP::use_cache;
#TODO: caching on (change file names)
-my $ORGDIR = '.'; # Cwd::getcwd();
open ORGOUT, '>&', *STDOUT;
open ORGOUT, '>&', *STDOUT;
+sub is_string ($$;$) {
+ my $tb = __PACKAGE__->builder;
+ $tb->is_eq(@_);
+}
+
eval {
eval {
+ # optionally replace unformatted is_string by LongString prettification
require Test::LongString;
Test::LongString->import(max => 128);
require Test::LongString;
Test::LongString->import(max => 128);
@@
-34,10
+38,10
@@
eval {
# align lines to: "____expected: "
return $s;
};
# align lines to: "____expected: "
return $s;
};
-} or
*is_string = \&is; # fallback to ugly unformatted is()
+} or
1;
sub _plp_run {
sub _plp_run {
- my ($src, $env, $in) = @_;
+ my ($src, $env, $in
put
) = @_;
%ENV = (
REQUEST_METHOD => 'GET',
%ENV = (
REQUEST_METHOD => 'GET',
@@
-46,19
+50,19
@@
sub _plp_run {
GATEWAY_INTERFACE => 'CGI/1.1',
SCRIPT_NAME => '/plp.cgi',
GATEWAY_INTERFACE => 'CGI/1.1',
SCRIPT_NAME => '/plp.cgi',
- SCRIPT_FILENAME => "
$ORGDIR
/plp.cgi",
+ SCRIPT_FILENAME => "
.
/plp.cgi",
PATH_INFO => "/$src/test/123",
PATH_INFO => "/$src/test/123",
- PATH_TRANSLATED => "
$ORGDIR
/$src/test/123",
- DOCUMENT_ROOT =>
$ORGDIR
,
+ PATH_TRANSLATED => "
.
/$src/test/123",
+ DOCUMENT_ROOT =>
"."
,
$env ? %{$env} : (),
); # Apache/2.2.4 CGI environment
$env ? %{$env} : (),
); # Apache/2.2.4 CGI environment
- if (defined $in) {
- $ENV{CONTENT_LENGTH} //= length $in;
+ if (defined $in
put
) {
+ $ENV{CONTENT_LENGTH} //= length $in
put
;
$ENV{CONTENT_TYPE} //= 'application/x-www-form-urlencoded';
close STDIN;
$ENV{CONTENT_TYPE} //= 'application/x-www-form-urlencoded';
close STDIN;
- open STDIN, '<', $in;
+ open STDIN, '<', $in
put
;
}
close STDOUT;
}
close STDOUT;
@@
-80,13
+84,14
@@
sub _plp_run {
}
sub plp_is {
}
sub plp_is {
- my ($name, $src, $expect, $env, $in) = @_;
+ my ($name, $src, $expect, $env, $input) = @_;
+ my $tb = __PACKAGE__->builder;
local $Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
- my ($output, $failure) = _plp_run($src, $env, $in);
+ my ($output, $failure) = _plp_run($src, $env, $in
put
);
if ($failure) {
if ($failure) {
-
fail(
$name);
- diag(" Error: $failure");
+
$tb->ok(0,
$name);
+
$tb->
diag(" Error: $failure");
return;
}
$output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
return;
}
$output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
@@
-107,38
+112,39
@@
sub _getwarning {
sub plp_ok {
my ($file, %replace) = @_;
sub plp_ok {
my ($file, %replace) = @_;
+ my $tb = __PACKAGE__->builder;
local $Test::Builder::Level = $Test::Builder::Level + 1;
(my $name = $file) =~ s/[.][^.]+$//;
$file = "$name.html";
local $Test::Builder::Level = $Test::Builder::Level + 1;
(my $name = $file) =~ s/[.][^.]+$//;
$file = "$name.html";
- my $
infile
= delete $replace{-input} // "$name.plp";
- my $
addin
= -e "$name.txt" && "$name.txt";
+ my $
src
= delete $replace{-input} // "$name.plp";
+ my $
input
= -e "$name.txt" && "$name.txt";
$name =~ s/^(\d*)-// and $name .= " ($1)";
DecodeURI($name);
$name =~ s/^(\d*)-// and $name .= " ($1)";
DecodeURI($name);
- my $out = eval {
+ my $out
put
= eval {
local $/ = undef; # slurp
open my $fh, '<', $file or die "$!\n";
return readline $fh;
};
local $/ = undef; # slurp
open my $fh, '<', $file or die "$!\n";
return readline $fh;
};
- if (not defined $out) {
-
fail(
$name);
- diag("error reading output from $file: $@");
+ if (not defined $out
put
) {
+
$tb->ok(0,
$name);
+
$tb->
diag("error reading output from $file: $@");
return;
}
my $env = delete $replace{-env};
$replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
$replace{VERSION } //= $PLP::VERSION;
return;
}
my $env = delete $replace{-env};
$replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
$replace{VERSION } //= $PLP::VERSION;
- $replace{SCRIPT_NAME } //= $
infile
;
- $replace{SCRIPT_FILENAME} //= "
$ORGDIR/$infile
";
+ $replace{SCRIPT_NAME } //= $
src
;
+ $replace{SCRIPT_FILENAME} //= "
./$src
";
- chomp $out;
- $out =~ s/\$$_/$replace{$_}/g for keys %replace;
- $out =~ s{
+ chomp $out
put
;
+ $out
put
=~ s/\$$_/$replace{$_}/g for keys %replace;
+ $out
put
=~ s{
<eval \s+ line="([^"]*)"> (.*?) </eval>
<eval \s+ line="([^"]*)"> (.*?) </eval>
- }{ _getwarning($2, $1, $
infile
) }msxge;
+ }{ _getwarning($2, $1, $
src
) }msxge;
- plp_is($name, $
infile, $out, $env, $addin
);
+ plp_is($name, $
src, $output, $env, $input
);
}
}