# 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 = $got eq $expected;
+
+ my $pass;
+ if( !defined $got || !defined $expected ) {
+ # undef only matches undef
+ $pass = !defined $got && !defined $expected;
+ }
+ else {
+ $pass = $got eq $expected;
+ }
+
unless ($pass) {
unshift(@mess, "# got "._q($got)."\n",
"# expected "._q($expected)."\n");
_ok($pass, _where(), $name, @mess);
}
-sub isnt {
+sub isnt ($$@) {
my ($got, $isnt, $name, @mess) = @_;
- my $pass = $got ne $isnt;
+
+ my $pass;
+ if( !defined $got || !defined $isnt ) {
+ # undef only matches undef
+ $pass = defined $got || defined $isnt;
+ }
+ else {
+ $pass = $got ne $isnt;
+ }
+
unless( $pass ) {
unshift(@mess, "# it should not be "._q($got)."\n",
"# but it is.\n");
_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 runperl {
+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" );
$runperldisplay =~ s/\n/\n\#/g;
print STDERR "# $runperldisplay\n";
}
+ return $runperl;
+}
+
+sub runperl {
+ my $runperl = &_create_runperl;
my $result = `$runperl`;
$result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
return $result;
}
#
-# 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/) :