t/op/threads.t

   1 #!./perl
   2 BEGIN {
   3      chdir 't' if -d 't';
   4      @INC = '../lib';
   5      require './test.pl';       # for which_perl() etc
   6 }
   7
   8 use strict;
   9 use Config;
  10
  11 BEGIN {
  12      if (!$Config{useithreads}) {
  13         print "1..0 # Skip: no ithreads\n";
  14         exit 0;
  15      }
  16      if ($ENV{PERL_CORE_MINITEST}) {
  17        print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
  18        exit 0;
  19      }
  20      plan(3);
  21 }
  22 use threads;
  23
  24 # test that we don't get:
  25 # Attempt to free unreferenced scalar: SV 0x40173f3c
  26 fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
  27 use threads;
  28 threads->new(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
  29 print "ok";
  30 EOI
  31
  32 #PR24660
  33 # test that we don't get:
  34 # Attempt to free unreferenced scalar: SV 0x814e0dc.
  35 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
  36 use threads;
  37 use Scalar::Util;
  38 my $data = "a";
  39 my $obj = \$data;
  40 my $copy = $obj;
  41 Scalar::Util::weaken($copy);
  42 threads->new(sub { 1 })->join for (1..1);
  43 print "ok";
  44 EOI
  45
  46 #PR24663
  47 # test that we don't get:
  48 # panic: magic_killbackrefs.
  49 # Scalars leaked: 3
  50 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
  51 package Foo;
  52 sub new { bless {},shift }
  53 package main;
  54 use threads;
  55 use Scalar::Util qw(weaken);
  56 my $object = Foo->new;
  57 my $ref = $object;
  58 weaken $ref;
  59 threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
  60 print "ok";
  61 EOI