# t/test.pl - most of Test::More functionality without the fuss
#
+$Level = 1;
my $test = 1;
my $planned;
}
sub _where {
- my @caller = caller(1);
+ my @caller = caller($Level);
return "at $caller[1] line $caller[2]";
}
# DON'T use this for matches. Use like() instead.
-sub ok {
+sub ok ($@) {
my ($pass, $name, @mess) = @_;
_ok($pass, _where(), $name, @mess);
}
return @result;
}
-sub is {
+sub is ($$@) {
my ($got, $expected, $name, @mess) = @_;
my $pass;
_ok($pass, _where(), $name, @mess);
}
-sub isnt {
+sub isnt ($$@) {
my ($got, $isnt, $name, @mess) = @_;
my $pass;
_ok($pass, _where(), $name, @mess);
}
-sub cmp_ok {
+sub cmp_ok ($$$@) {
my($got, $type, $expected, $name, @mess) = @_;
my $pass;
# otherwise $range is a fractional error.
# Here $range must be numeric, >= 0
# Non numeric ranges might be a useful future extension. (eg %)
-sub within {
+sub within ($$$@) {
my ($got, $expected, $range, $name, @mess) = @_;
my $pass;
if (!defined $got or !defined $expected or !defined $range) {
}
# Note: this isn't quite as fancy as Test::More::like().
-sub like {
+sub like ($$@) {
my ($got, $expected, $name, @mess) = @_;
my $pass;
if (ref $expected eq 'Regexp') {
!$fail;
}
-sub require_ok {
+sub require_ok ($) {
my ($require) = @_;
eval <<REQUIRE_OK;
require $require;
_ok(!$@, _where(), "require $require");
}
-sub use_ok {
+sub use_ok ($) {
my ($use) = @_;
eval <<USE_OK;
use $use;
sub _create_runperl { # Create the string to qx in runperl().
my %args = @_;
- my $runperl = $^X;
+ my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
unless ($args{nolib}) {
if ($is_macos) {
$runperl .= ' -I::lib';
}
}
if ($args{switches}) {
+ local $Level = 2;
+ die "test.pl:runperl(): 'switches' must be an ARRAYREF " . _where()
+ unless ref $args{switches} eq "ARRAY";
_quote_args(\$runperl, $args{switches});
}
if (defined $args{prog}) {
+ die "test.pl:runperl(): both 'prog' and 'progs' cannot be used " . _where()
+ if defined $args{progs};
$args{progs} = [$args{prog}]
}
if (defined $args{progs}) {
+ die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
+ unless ref $args{progs} eq "ARRAY";
foreach my $prog (@{$args{progs}}) {
if ($is_mswin || $is_netware || $is_vms) {
$runperl .= qq ( -e "$prog" );
}
#
-# run_perl_is
+# fresh_perl_is
#
# Combination of run_perl() and is().
#
sub fresh_perl_is {
my($prog, $expected, $runperl_args, $name) = @_;
+ local $Level = 2;
_fresh_perl($prog,
sub { @_ ? $_[0] eq $expected : $expected },
$runperl_args, $name);
}
#
-# run_perl_like
+# fresh_perl_like
#
# Combination of run_perl() and like().
#
sub fresh_perl_like {
my($prog, $expected, $runperl_args, $name) = @_;
+ local $Level = 2;
_fresh_perl($prog,
sub { @_ ?
$_[0] =~ (ref $expected ? $expected : /$expected/) :