This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Simplify the logic in t/thread_it.pl, as the callers' filenames are uniform.
authorNicholas Clark <nick@ccl4.org>
Tue, 8 Mar 2011 10:31:32 +0000 (10:31 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 8 Mar 2011 10:32:23 +0000 (10:32 +0000)
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".

t/op/index_thr.t
t/re/pat_advanced_thr.t
t/re/pat_psycho_thr.t
t/re/pat_re_eval_thr.t
t/re/pat_rt_report_thr.t
t/re/pat_special_cc_thr.t
t/re/pat_thr.t
t/re/reg_email_thr.t
t/re/regexp_unicode_prop_thr.t
t/re/substr_thr.t
t/thread_it.pl

index 3a97741..9ce1d3a 100644 (file)
@@ -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';
index 0dc5dd8..9ce1d3a 100644 (file)
@@ -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';
index 4134cdc..9ce1d3a 100644 (file)
@@ -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';
index 706bfbf..9ce1d3a 100644 (file)
@@ -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';
index 8a9916d..9ce1d3a 100644 (file)
@@ -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';
index f06e225..9ce1d3a 100644 (file)
@@ -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';
index 159be92..9ce1d3a 100644 (file)
@@ -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';
index 2432126..9ce1d3a 100644 (file)
@@ -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';
index 607ad94..9ce1d3a 100644 (file)
@@ -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';
index 295c617..9ce1d3a 100644 (file)
@@ -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';
index cbe979f..37d4680 100644 (file)
@@ -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;