$planned = $n;
}
+
+# Set the plan at the end. See Test::More::done_testing.
+sub done_testing {
+ my $n = $test - 1;
+ $n = shift if @_;
+
+ _print "1..$n\n";
+ $planned = $n;
+}
+
+
END {
my $ran = $test - 1;
if (!$NO_ENDING) {
}
}
-# Use this instead of "print STDERR" when outputing failure diagnostic
-# messages
sub _diag {
return unless @_;
- my @mess = map { /^#/ ? "$_\n" : "# $_\n" }
- map { split /\n/ } @_;
+ my @mess = _comment(@_);
$TODO ? _print(@mess) : _print_stderr(@mess);
}
+# Use this instead of "print STDERR" when outputing failure diagnostic
+# messages
sub diag {
_diag(@_);
}
+# Use this instead of "print" when outputing informational messages
+sub note {
+ return unless @_;
+ _print( _comment(@_) );
+}
+
+sub _comment {
+ return map { /^#/ ? "$_\n" : "# $_\n" }
+ map { split /\n/ } @_;
+}
+
sub skip_all {
if (@_) {
_print "1..0 # Skip @_\n";
# Arguments :
# switches => [ command-line switches ]
# nolib => 1 # don't use -I../lib (included by default)
+# non_portable => Don't warn if a one liner contains quotes
# prog => one-liner (avoid quotes)
# progs => [ multi-liner (avoid quotes) ]
# progfile => perl script
die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
unless ref $args{progs} eq "ARRAY";
foreach my $prog (@{$args{progs}}) {
+ if ($prog =~ tr/'"// && !$args{non_portable}) {
+ warn "quotes in prog >>$prog<< are not portable";
+ }
if ($is_mswin || $is_netware || $is_vms) {
$runperl = $runperl . qq ( -e "$prog" );
}
join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
split quotemeta ($sep), $1;
- $ENV{PATH} = $ENV{PATH} . "$sep/bin" if $is_cygwin; # Must have /bin under Cygwin
-
+ if ($is_cygwin) { # Must have /bin under Cygwin
+ if (length $ENV{PATH}) {
+ $ENV{PATH} = $ENV{PATH} . $sep;
+ }
+ $ENV{PATH} = $ENV{PATH} . '/bin';
+ }
$runperl =~ /(.*)/s;
$runperl = $1;
return $result;
}
-*run_perl = \&runperl; # Nice alias.
+# Nice alias
+*run_perl = *run_perl = \&runperl; # shut up "used only once" warning
sub DIE {
_print_stderr "# @_\n";
_ok( !@nok, _where(), $name );
}
+
+# Call $class->new( @$args ); and run the result through isa_ok.
+# See Test::More::new_ok
+sub new_ok {
+ my($class, $args, $obj_name) = @_;
+ $args ||= [];
+ $object_name = "The object" unless defined $obj_name;
+
+ local $Level = $Level + 1;
+
+ my $obj;
+ my $ok = eval { $obj = $class->new(@$args); 1 };
+ my $error = $@;
+
+ if($ok) {
+ isa_ok($obj, $class, $object_name);
+ }
+ else {
+ ok( 0, "new() died" );
+ diag("Error was: $@");
+ }
+
+ return $obj;
+
+}
+
+
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
# Set a watchdog to timeout the entire test file
# NOTE: If the test file uses 'threads', then call the watchdog() function
# _AFTER_ the 'threads' module is loaded.
-sub watchdog ($)
+sub watchdog ($;$)
{
my $timeout = shift;
+ my $method = shift || "";
my $timeout_msg = 'Test process timed out - terminating';
# Valgrind slows perl way down so give it more time before dying.
my $pid_to_kill = $$; # PID for this process
+ if ($method eq "alarm") {
+ goto WATCHDOG_VIA_ALARM;
+ }
+
+ # shut up use only once warning
+ my $threads_on = $threads::threads && $threads::threads;
+
# Don't use a watchdog process if 'threads' is loaded -
# use a watchdog thread instead
- if (! $threads::threads) {
+ if (!$threads_on) {
# On Windows and VMS, try launching a watchdog process
# using system(1, ...) (see perlport.pod)
}
# If everything above fails, then just use an alarm timeout
+WATCHDOG_VIA_ALARM:
if (eval { alarm($timeout); 1; }) {
# Load POSIX if available
eval { require POSIX; };
return $string;
}
+sub ord_latin1_to_native {
+ # given an input latin1 code point, return the platform's native
+ # equivalent value
+
+ return ord latin1_to_native(chr $_[0]);
+}
+
+sub ord_native_to_latin1 {
+ # given an input platform code point, return the latin1 equivalent value
+
+ return ord native_to_latin1(chr $_[0]);
+}
+
1;