| 1 | use warnings;
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | # chdir 't' if -d 't';
|
|---|
| 5 | # push @INC ,'../lib';
|
|---|
| 6 | require Config; import Config;
|
|---|
| 7 | unless ($Config{'useithreads'}) {
|
|---|
| 8 | print "1..0 # Skip: no useithreads\n";
|
|---|
| 9 | exit 0;
|
|---|
| 10 | }
|
|---|
| 11 | }
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 | sub ok {
|
|---|
| 15 | my ($id, $ok, $name) = @_;
|
|---|
| 16 |
|
|---|
| 17 | $name = '' unless defined $name;
|
|---|
| 18 | # You have to do it this way or VMS will get confused.
|
|---|
| 19 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
|
|---|
| 20 |
|
|---|
| 21 | printf "# Failed test at line %d\n", (caller)[2] unless $ok;
|
|---|
| 22 |
|
|---|
| 23 | return $ok;
|
|---|
| 24 | }
|
|---|
| 25 |
|
|---|
| 26 | use ExtUtils::testlib;
|
|---|
| 27 | use strict;
|
|---|
| 28 | BEGIN { print "1..11\n" };
|
|---|
| 29 | use threads;
|
|---|
| 30 | use threads::shared;
|
|---|
| 31 | ok(1,1,"loaded");
|
|---|
| 32 |
|
|---|
| 33 | my $sv;
|
|---|
| 34 | share($sv);
|
|---|
| 35 | $sv = "hi";
|
|---|
| 36 | my @av;
|
|---|
| 37 | share(@av);
|
|---|
| 38 | push @av, $sv;
|
|---|
| 39 | ok(2, $av[0] eq "hi");
|
|---|
| 40 | push @av, "foo";
|
|---|
| 41 | ok(3, $av[1] eq 'foo');
|
|---|
| 42 | my $av = threads->create(sub {
|
|---|
| 43 | my $av;
|
|---|
| 44 | my @av2;
|
|---|
| 45 | share($av);
|
|---|
| 46 | share(@av2);
|
|---|
| 47 | $av = \@av2;
|
|---|
| 48 | push @$av, "bar", \@av;
|
|---|
| 49 | return $av;
|
|---|
| 50 | })->join();
|
|---|
| 51 | ok(4,$av->[0] eq "bar");
|
|---|
| 52 | ok(5,$av->[1]->[0] eq 'hi');
|
|---|
| 53 | threads->create(sub { $av[0] = "hihi" })->join();
|
|---|
| 54 | ok(6,$av->[1]->[0] eq 'hihi');
|
|---|
| 55 | ok(7, pop(@{$av->[1]}) eq "foo");
|
|---|
| 56 | ok(8, scalar(@{$av->[1]}) == 1);
|
|---|
| 57 | threads->create(sub { @$av = () })->join();
|
|---|
| 58 | threads->create(sub { ok(9, scalar @$av == 0)})->join();
|
|---|
| 59 | threads->create(sub { unshift(@$av, threads->create(sub { my @array; share(@array); return \@array})->join())})->join();
|
|---|
| 60 | ok(10, ref($av->[0]) eq 'ARRAY');
|
|---|
| 61 | threads->create(sub { push @{$av->[0]}, \@av })->join();
|
|---|
| 62 | threads->create(sub { $av[0] = 'testtest'})->join();
|
|---|
| 63 | threads->create(sub { ok(11, $av->[0]->[0]->[0] eq 'testtest')})->join();
|
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 |
|
|---|
| 67 |
|
|---|
| 68 |
|
|---|
| 69 |
|
|---|