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: base Test::PLP on Test::Builder::Module
[perl/plp/.git]
/
lib
/
Test
/
PLP.pm
diff --git
a/lib/Test/PLP.pm
b/lib/Test/PLP.pm
index edadc874a5ebf3ff3f8992d6a5f47df865e66b07..d1ebb4cd4e740fad2298285a69de240303cb0b4b 100644
(file)
--- a/
lib/Test/PLP.pm
+++ b/
lib/Test/PLP.pm
@@
-4,14
+4,14
@@
use strict;
use warnings;
use Cwd;
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;
our @EXPORT = qw( plp_is plp_ok );
$PLP::use_cache = 0 if $PLP::use_cache;
@@
-20,7
+20,13
@@
$PLP::use_cache = 0 if $PLP::use_cache;
my $ORGDIR = '.'; # Cwd::getcwd();
open ORGOUT, '>&', *STDOUT;
my $ORGDIR = '.'; # Cwd::getcwd();
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,7
+40,7
@@
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 {
my ($src, $env, $in) = @_;
sub _plp_run {
my ($src, $env, $in) = @_;
@@
-81,12
+87,13
@@
sub _plp_run {
sub plp_is {
my ($name, $src, $expect, $env, $in) = @_;
sub plp_is {
my ($name, $src, $expect, $env, $in) = @_;
+ my $tb = __PACKAGE__->builder;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($output, $failure) = _plp_run($src, $env, $in);
if ($failure) {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($output, $failure) = _plp_run($src, $env, $in);
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,6
+114,7
@@
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/[.][^.]+$//;
local $Test::Builder::Level = $Test::Builder::Level + 1;
(my $name = $file) =~ s/[.][^.]+$//;
@@
-122,8
+130,8
@@
sub plp_ok {
return readline $fh;
};
if (not defined $out) {
return readline $fh;
};
if (not defined $out) {
-
fail(
$name);
- diag("error reading output from $file: $@");
+
$tb->ok(0,
$name);
+
$tb->
diag("error reading output from $file: $@");
return;
}
return;
}