In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/77ba2250b324d4fdc54cedfc356f3197ea6cc717?hp=4692e667eb5fcc19306bd345ec7d08f52a1157c6>
- Log ----------------------------------------------------------------- commit 77ba2250b324d4fdc54cedfc356f3197ea6cc717 Author: Nicholas Clark <[email protected]> Date: Tue Mar 8 10:46:14 2011 +0000 Refactor skip_all_without_config() to take a list of config options to test. Previously it took a second argument as a reason to show in the skip_all message, if the config option was not set. However, no callers were using it, so remove it. This allows skip_all_without_config() to take a list of keys to test, which is useful to two of its callers. M t/op/getpid.t M t/op/getppid.t M t/test.pl commit 4f018ed094fde8223d458959a30ea42ff841f880 Author: Nicholas Clark <[email protected]> Date: Tue Mar 8 10:31:32 2011 +0000 Simplify the logic in t/thread_it.pl, as the callers' filenames are uniform. VMS invokes TEST with Unix-style filenames, so using / as a separator inside t/thread_it.pl should not pose a portability problem. ':' is irrelevant now that MacOS Classic is very "special biologist word". M t/op/index_thr.t M t/re/pat_advanced_thr.t M t/re/pat_psycho_thr.t M t/re/pat_re_eval_thr.t M t/re/pat_rt_report_thr.t M t/re/pat_special_cc_thr.t M t/re/pat_thr.t M t/re/reg_email_thr.t M t/re/regexp_unicode_prop_thr.t M t/re/substr_thr.t M t/thread_it.pl commit 224b2e7e6be9296f0761c242069908f4a4e2bf16 Author: Nicholas Clark <[email protected]> Date: Tue Mar 8 09:56:48 2011 +0000 4f890a3067e1198f missed qr// from t/re/pat.t in its refactoring in two places. like($@, /A pattern/, "Description") is going to compare $@ with the *result* of matching $_ against that pattern, not that pattern. M t/re/pat.t ----------------------------------------------------------------------- Summary of changes: t/op/getpid.t | 2 +- t/op/getppid.t | 2 +- t/op/index_thr.t | 6 +----- t/re/pat.t | 4 ++-- t/re/pat_advanced_thr.t | 6 +----- t/re/pat_psycho_thr.t | 6 +----- t/re/pat_re_eval_thr.t | 6 +----- t/re/pat_rt_report_thr.t | 6 +----- t/re/pat_special_cc_thr.t | 6 +----- t/re/pat_thr.t | 6 +----- t/re/reg_email_thr.t | 6 +----- t/re/regexp_unicode_prop_thr.t | 6 +----- t/re/substr_thr.t | 6 +----- t/test.pl | 9 ++++----- t/thread_it.pl | 40 +++++++++++++++++++--------------------- 15 files changed, 37 insertions(+), 80 deletions(-) diff --git a/t/op/getpid.t b/t/op/getpid.t index a06a0c6..7c1c042 100644 --- a/t/op/getpid.t +++ b/t/op/getpid.t @@ -12,7 +12,7 @@ use strict; use Config; BEGIN { - skip_all_without_config($_) foreach qw(useithreads d_getppid); + skip_all_without_config(qw(useithreads d_getppid)); skip_all_if_miniperl("no dynamic loading on miniperl, no threads"); eval 'use threads; use threads::shared'; plan tests => 3; diff --git a/t/op/getppid.t b/t/op/getppid.t index 23428f0..a631610 100644 --- a/t/op/getppid.t +++ b/t/op/getppid.t @@ -16,7 +16,7 @@ use strict; BEGIN { require './test.pl'; - skip_all_without_config($_) foreach qw(d_pipe d_fork d_waitpid d_getppid); + skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid)); plan (8); } diff --git a/t/op/index_thr.t b/t/op/index_thr.t index 3a97741..9ce1d3a 100644 --- a/t/op/index_thr.t +++ b/t/op/index_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(op index.t)); +require './thread_it.pl'; diff --git a/t/re/pat.t b/t/re/pat.t index 3b170c8..a14cb4f 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -317,7 +317,7 @@ sub run_tests { is($@, '', $message); eval "'aaa' =~ /a{1,$::reg_infty}/"; - like($@, /^\QQuantifier in {,} bigger than/, $message); + like($@, qr/^\QQuantifier in {,} bigger than/, $message); eval "'aaa' =~ /a{1,$::reg_infty_p}/"; like($@, qr/^\QQuantifier in {,} bigger than/, $message); } @@ -338,7 +338,7 @@ sub run_tests { unlike("b$a=", qr/a$a=/, $message); like("b$a=", qr/ba+=/, $message); - like("ba$a=", /b(?:a|b)+=/, $message); + like("ba$a=", qr/b(?:a|b)+=/, $message); } } diff --git a/t/re/pat_advanced_thr.t b/t/re/pat_advanced_thr.t index 0dc5dd8..9ce1d3a 100644 --- a/t/re/pat_advanced_thr.t +++ b/t/re/pat_advanced_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat_advanced.t)); +require './thread_it.pl'; diff --git a/t/re/pat_psycho_thr.t b/t/re/pat_psycho_thr.t index 4134cdc..9ce1d3a 100644 --- a/t/re/pat_psycho_thr.t +++ b/t/re/pat_psycho_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat_psycho.t)); +require './thread_it.pl'; diff --git a/t/re/pat_re_eval_thr.t b/t/re/pat_re_eval_thr.t index 706bfbf..9ce1d3a 100644 --- a/t/re/pat_re_eval_thr.t +++ b/t/re/pat_re_eval_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat_re_eval.t)); +require './thread_it.pl'; diff --git a/t/re/pat_rt_report_thr.t b/t/re/pat_rt_report_thr.t index 8a9916d..9ce1d3a 100644 --- a/t/re/pat_rt_report_thr.t +++ b/t/re/pat_rt_report_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat_rt_report.t)); +require './thread_it.pl'; diff --git a/t/re/pat_special_cc_thr.t b/t/re/pat_special_cc_thr.t index f06e225..9ce1d3a 100644 --- a/t/re/pat_special_cc_thr.t +++ b/t/re/pat_special_cc_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat_special_cc.t)); +require './thread_it.pl'; diff --git a/t/re/pat_thr.t b/t/re/pat_thr.t index 159be92..9ce1d3a 100644 --- a/t/re/pat_thr.t +++ b/t/re/pat_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re pat.t)); +require './thread_it.pl'; diff --git a/t/re/reg_email_thr.t b/t/re/reg_email_thr.t index 2432126..9ce1d3a 100644 --- a/t/re/reg_email_thr.t +++ b/t/re/reg_email_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re reg_email.t)); +require './thread_it.pl'; diff --git a/t/re/regexp_unicode_prop_thr.t b/t/re/regexp_unicode_prop_thr.t index 607ad94..9ce1d3a 100644 --- a/t/re/regexp_unicode_prop_thr.t +++ b/t/re/regexp_unicode_prop_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re regexp_unicode_prop.t)); +require './thread_it.pl'; diff --git a/t/re/substr_thr.t b/t/re/substr_thr.t index 295c617..9ce1d3a 100644 --- a/t/re/substr_thr.t +++ b/t/re/substr_thr.t @@ -1,7 +1,3 @@ #!./perl - chdir 't' if -d 't'; -@INC = ('../lib', '.'); - -require 'thread_it.pl'; -thread_it(qw(re substr.t)); +require './thread_it.pl'; diff --git a/t/test.pl b/t/test.pl index fa151ec..01035af 100644 --- a/t/test.pl +++ b/t/test.pl @@ -137,18 +137,17 @@ sub skip_all_without_perlio { } sub skip_all_without_config { - my ($key, $reason) = @_; unless (eval 'require Config; 1') { warn "test.pl had problems loading Config: $@"; return; } - return if $Config::Config{$key}; - unless (defined $reason) { + foreach (@_) { + next if $Config::Config{$_}; + my $key = $_; # Need to copy, before trying to modify. $key =~ s/^use//; $key =~ s/^d_//; - $reason = "no $key"; + skip_all("no $key"); } - skip_all($reason); } sub _ok { diff --git a/t/thread_it.pl b/t/thread_it.pl index cbe979f..37d4680 100644 --- a/t/thread_it.pl +++ b/t/thread_it.pl @@ -13,26 +13,24 @@ skip_all_if_miniperl("no dynamic loading on miniperl, no threads"); require threads; -sub thread_it { - # Generate things like './op/regexp.t', './t/op/regexp.t', ':op:regexp.t' - my @paths - = (join ('/', '.', @_), join ('/', '.', 't', @_), join (':', @_)); - - for my $file (@paths) { - if (-r $file) { - print "# found tests in $file\n"; - $::running_as_thread = "running tests in a new thread"; - do $file or die $@; - print "# running tests in a new thread\n"; - my $curr = threads->create(sub { - run_tests(); - return defined &curr_test ? curr_test() : () - })->join(); - curr_test($curr) if defined $curr; - exit; - } - } - die "Cannot find " . join (" or ", @paths) . "\n"; -} +# Which file called us? +my $caller = (caller)[1]; + +die "Can't figure out which test to run from filename '$caller'" + unless $caller =~ m!((?:op|re)/[-_a-z0-9A-Z]+)_thr\.t\z!; + +my $file = "$1.t"; + +$::running_as_thread = "running tests in a new thread"; +require $file; + +note('running tests in a new thread'); + +my $curr = threads->create(sub { + run_tests(); + return defined &curr_test ? curr_test() : () + })->join(); + +curr_test($curr) if defined $curr; 1; -- Perl5 Master Repository
