threads
view release on metacpan or search on metacpan
use ExtUtils::testlib;
sub ok {
my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..34\n"); ### Number of tests that will be run ###
};
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
print(STDERR "# FAIL: $name\n") if (! $ENV{'PERL_CORE'});
}
return ($ok);
}
### Start of Testing ###
$SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
t/context.t view on Meta::CPAN
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
### Start of Testing ###
sub foo
{
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
### Start of Testing ###
# Test that END blocks are run in the thread that created them,
# and not in any child threads.
while ($q->pending()) {
my $ok = $q->dequeue();
my $name = $q->dequeue();
my $id = $TEST++;
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
}
}
### Start of Testing ###
ok(1, 'Loaded');
# Tests freeing the Perl interpreter for each thread
# See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
while ($q->pending()) {
my $ok = $q->dequeue();
my $name = $q->dequeue();
my $id = $TEST++;
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
}
}
### Start of Testing ###
ok(1, 'Loaded');
# Tests freeing the Perl interpreter for each thread
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
sub skip {
ok(1, '# SKIP ' . $_[0]);
}
while ($q->pending()) {
my $ok = $q->dequeue();
my $name = $q->dequeue();
my $id = $TEST++;
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
}
}
### Start of Testing ###
ok(1, 'Loaded');
### Thread cancel ###
use ExtUtils::testlib;
sub ok {
my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..15\n"); ### Number of tests that will be run ###
};
t/no_threads.t view on Meta::CPAN
use ExtUtils::testlib;
sub ok {
my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..1\n"); ### Number of tests that will be run ###
};
use ExtUtils::testlib;
sub ok {
my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..18\n"); ### Number of tests that will be run ###
};
t/stack_env.t view on Meta::CPAN
use ExtUtils::testlib;
sub ok {
my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..4\n"); ### Number of tests that will be run ###
$ENV{'PERL5_ITHREADS_STACK_SIZE'} = 128*4096;
my ($ok, $name) = @_;
lock($TEST);
my $id = $TEST++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $id - $name\n");
} else {
print("not ok $id - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
### Start of Testing ###
my ($READY, $GO, $DONE) :shared = (0, 0, 0);
t/stress_cv.t view on Meta::CPAN
my $test = 0;
sub ok {
my ($ok, $name) = @_;
$test++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $test - $name\n");
} else {
print("not ok $test - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..61\n"); ### Number of tests that will be run ###
};
t/stress_re.t view on Meta::CPAN
my $test = 0;
sub ok {
my ($ok, $name) = @_;
$test++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $test - $name\n");
} else {
print("not ok $test - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..61\n"); ### Number of tests that will be run ###
};
t/stress_string.t view on Meta::CPAN
my $test = 0;
sub ok {
my ($ok, $name) = @_;
$test++;
# You have to do it this way or VMS will get confused.
if ($ok) {
print("ok $test - $name\n");
} else {
print("not ok $test - $name\n");
printf("# Failed test at line %d\n", (caller)[2]);
}
return ($ok);
}
BEGIN {
$| = 1;
print("1..61\n"); ### Number of tests that will be run ###
};
sub run_multiple_progs {
my $up = shift;
my @prgs;
if ($up) {
# The tests in lib run in a temporary subdirectory of t, and always
# pass in a list of "programs" to run
@prgs = @_;
} else {
# The tests below t run in t and pass in a file handle. In theory we
# can pass (caller)[1] as the second argument to report errors with
# the filename of our caller, as the handle is always DATA. However,
# line numbers in DATA count from the __END__ token, so will be wrong.
# Which is more confusing than not providing line numbers. So, for now,
# don't provide line numbers. No obvious clean solution - one hack
# would be to seek DATA back to the start and read to the __END__ token,
# but that feels almost like we should just open $0 instead.
# Not going to rely on undef in list assignment.
my $dummy;
($dummy, @prgs) = _setup_one_file(shift);
( run in 1.924 second using v1.01-cache-2.11-cpan-a3c8064c92c )