This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug #18573 : in a double-quoted string, a \c not followed
[perl5.git] / ext / threads / t / join.t
CommitLineData
e1c44605
AB
1
2BEGIN {
3 chdir 't' if -d 't';
4 @INC = '../lib';
5 require Config; import Config;
6 unless ($Config{'useithreads'}) {
7 print "1..0 # Skip: no useithreads\n";
8 exit 0;
9 }
10}
11
12use ExtUtils::testlib;
13use strict;
e2975953 14BEGIN { print "1..11\n" };
e1c44605
AB
15use threads;
16use threads::shared;
17
18my $test_id = 1;
19share($test_id);
20use Devel::Peek qw(Dump);
21
22sub ok {
23 my ($ok, $name) = @_;
24
25 # You have to do it this way or VMS will get confused.
26 print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
27
28 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
29 $test_id++;
30 return $ok;
31}
32
33ok(1,"");
34
35
36{
37 my $retval = threads->create(sub { return ("hi") })->join();
38 ok($retval eq 'hi', "Check basic returnvalue");
39}
40{
41 my ($thread) = threads->create(sub { return (1,2,3) });
42 my @retval = $thread->join();
43 ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3);
44}
45{
46 my $retval = threads->create(sub { return [1] })->join();
47 ok($retval->[0] == 1,"Check that a array ref works");
48}
49{
50 my $retval = threads->create(sub { return { foo => "bar" }})->join();
51 ok($retval->{foo} eq 'bar',"Check that hash refs work");
52}
53{
54 my $retval = threads->create( sub {
55 open(my $fh, "+>threadtest") || die $!;
56 print $fh "test\n";
57 return $fh;
58 })->join();
59 ok(ref($retval) eq 'GLOB', "Check that we can return FH $retval");
60 print $retval "test2\n";
61# seek($retval,0,0);
62# ok(<$retval> eq "test\n");
63 close($retval);
64 unlink("threadtest");
65}
66{
67 my $test = "hi";
68 my $retval = threads->create(sub { return $_[0]}, \$test)->join();
69 ok($$retval eq 'hi');
70}
71{
72 my $test = "hi";
73 share($test);
74 my $retval = threads->create(sub { return $_[0]}, \$test)->join();
75 ok($$retval eq 'hi');
76 $test = "foo";
77 ok($$retval eq 'foo');
78}
79{
80 my %foo;
81 share(%foo);
82 threads->create(sub {
83 my $foo;
84 share($foo);
85 $foo = "thread1";
86 return $foo{bar} = \$foo;
87 })->join();
88 ok(1,"");
89}
e2975953
JH
90
91if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
92
93 # First modify $0 in a subthread.
94 print "# 1a: \$0 = $0\n";
95 join( threads->new( sub {
96 print "# 2a: \$0 = $0\n";
97 $0 = "foobar";
98 print "# 2b: \$0 = $0\n" } ) );
99 print "# 1b: \$0 = $0\n";
100 if (open PS, "ps -f |") {
101 my $ok;
102 while (<PS>) {
103 print "# $_";
104 if (/^\S+\s+$$\s.+\sfoobar\s*$/) {
105 $ok++;
106 last;
107 }
108 }
109 close PS;
110 ok($ok, 'altering $0 is effective');
111 } else {
112 skip("\$0 check: opening 'ps -f |' failed: $!");
113 }
114} else {
115 skip("\$0 check: only on Linux");
116}