Update Encode to CPAN version 2.78

[perl5.git] / t / op / threads.t

diff --git a/t/op/threads.t b/t/op/threads.t
index cf11ead..e76c956 100644 (file)
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -6,17 +6,10 @@ BEGIN {
      require './test.pl';
      $| = 1;
 
-     require Config;
-     if (!$Config::Config{useithreads}) {
-        print "1..0 # Skip: no ithreads\n";
-        exit 0;
-     }
-     if ($ENV{PERL_CORE_MINITEST}) {
-       print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
-       exit 0;
-     }
-
-     plan(23);
+     skip_all_without_config('useithreads');
+     skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
+
+     plan(28);
 }
 
 use strict;
@@ -142,6 +135,7 @@ EOI
 #
 # run-time usage of newCONSTSUB (as done by the IO boot code) wasn't
 # thread-safe - got occasional coredumps or malloc corruption
+watchdog(180, "process");
 {
     local $SIG{__WARN__} = sub {};   # Ignore any thread creation failure warnings
     my @t;
@@ -166,8 +160,8 @@ curr_test(curr_test() + 2);
 
 
 # the seen_evals field of a regexp was getting zeroed on clone, so
-# within a thread it didn't  know that a regex object contrained a 'safe'
-# re_eval expression, so it later died with 'Eval-group not allowed' when
+# within a thread it didn't  know that a regex object contained a 'safe'
+# code expression, so it later died with 'Eval-group not allowed' when
 # you tried to interpolate the object
 
 sub safe_re {
@@ -349,4 +343,66 @@ threads->create(
 
 EOI
 
+# make sure peephole optimiser doesn't recurse heavily.
+# (We run this inside a thread to get a small stack)
+
+{
+    # lots of constructs that have o->op_other etc
+    my $code = <<'EOF';
+       $r = $x || $y;
+       $x ||= $y;
+       $r = $x // $y;
+       $x //= $y;
+       $r = $x && $y;
+       $x &&= $y;
+       $r = $x ? $y : $z;
+       @a = map $x+1, @a;
+       @a = grep $x+1, @a;
+       $r = /$x/../$y/;
+
+       # this one will fail since we removed tail recursion optimisation
+       # with f11ca51e41e8
+       #while (1) { $x = 0 };
+
+       while (0) { $x = 0 };
+       for ($x=0; $y; $z=0) { $r = 0 };
+       for (1) { $x = 0 };
+       { $x = 0 };
+       $x =~ s/a/$x + 1/e;
+EOF
+    $code = 'my ($r, $x,$y,$z,@a); return 5; ' . ($code x 1000);
+    my $res = threads->create(sub { eval $code})->join;
+    is($res, 5, "avoid peephole recursion");
+}
+
+
+# [perl #78494] Pipes shared between threads block when closed
+{
+  my $perl = which_perl;
+  $perl = qq'"$perl"' if $perl =~ /\s/;
+  open(my $OUT, "|$perl") || die("ERROR: $!");
+  threads->create(sub { })->join;
+  ok(1, "Pipes shared between threads do not block when closed");
+}
+
+# [perl #105208] Typeglob clones should not be cloned again during a join
+{
+  threads->create(sub { sub { $::hypogamma = 3 } })->join->();
+  is $::hypogamma, 3, 'globs cloned and joined are not recloned';
+}
+
+fresh_perl_is(
+  'use threads;' .
+  'async { delete $::{INC}; eval q"my $foo : bar" } ->join; print "ok\n";',
+  "ok",
+   {},
+  'no crash when deleting $::{INC} in thread'
+);
+
+fresh_perl_is(<<'CODE', 'ok', 'no crash modifying extended array element');
+use threads;
+my @a = 1;
+threads->create(sub { $#a = 1; $a[1] = 2; print qq/ok\n/ })->join;
+CODE
+
 # EOF