4 use RT::Test tests => 35;
7 use RT::Util qw(safe_run_child);
13 my $res = safe_run_child { return 1 };
14 is $res, 1, "correct return value";
23 $context = 'array'; return 1, 2, 3;
24 } elsif ( defined wantarray ) {
25 $context = 'scalar'; return 'foo';
26 } elsif ( !wantarray ) {
27 $context = 'void'; return;
30 is_deeply [ safe_run_child { $sub->(@_) } ], [1, 2, 3];
34 is scalar safe_run_child {$sub->(@_)}, 'foo';
35 is $context, 'scalar';
38 safe_run_child {$sub->(@_)};
45 my $res = safe_run_child {
46 if (fork) { wait; return 'parent' }
48 open my $fh, '>', RT::Test->temp_directory .'/tttt';
54 is $res, 'parent', "correct return value";
55 is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
57 'correct file content',
65 my $res = safe_run_child {
66 if (fork) { wait; return 'parent' }
68 open my $fh, '>', RT::Test->temp_directory .'/tttt';
74 is $res, 'parent', "correct return value";
75 is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
77 'correct file content',
79 } qr/System Error: child/;
85 my $res = safe_run_child {
86 if (fork) { wait; return 'parent' }
88 open my $fh, '>', RT::Test->temp_directory .'/tttt';
94 is $res, 'parent', "correct return value";
95 is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
97 'correct file content',
104 my $res = eval { safe_run_child { die 'parent'; } };
105 is $res, undef, "correct return value";
106 like $@, qr'System Error: parent', "correct error message value";
112 my $script = RT::Test->temp_directory .'/true.pl';
113 open my $fh, '>', $script;
117 open my \$fh, '>', '$script.res';
126 my $res = safe_run_child {
127 if (fork) { wait; return 'parent' }
130 is $res, 'parent', "correct return value";
131 is( RT::Test->file_content([$script .'.res'], unlink => 1 ),
133 'correct file content',
138 # fork+parent that doesn't wait()
141 my $start = Time::HiRes::time();
144 # Set up a poor man's semaphore
146 $SIG{USR1} = sub {$all_set++};
148 my $res = safe_run_child {
149 if ($pid = fork) { return 'parent' }
151 open my $fh, '>', RT::Test->temp_directory .'/first';
154 # Signal that the first file is now all set; we need to do this
155 # to avoid a race condition
156 kill POSIX::SIGUSR1(), getppid();
160 open $fh, '>', RT::Test->temp_directory .'/second';
166 ok( Time::HiRes::time() - $start < 5, "Didn't wait until child finished" );
168 # Wait for up to 3 seconds to get signaled that the child has made
169 # the file (the USR1 will break out of the sleep()). This _should_
170 # be immediate, but there's a race between the parent and child
171 # here, since there's no wait()'ing. There's still a tiny race
172 # where the signal could come in betwene the $all_set check and the
173 # sleep, but that just means we sleep for 3 seconds uselessly.
174 sleep 3 unless $all_set;
176 is $res, 'parent', "correct return value";
177 is( RT::Test->file_content([RT::Test->temp_directory, 'first'], unlink => 1 ),
179 'correct file content',
181 ok( not(-f RT::Test->temp_directory.'/second'), "Second file does not exist yet");
184 ok(waitpid($pid,0), "Waited until child finished to reap");
185 is( RT::Test->file_content([RT::Test->temp_directory, 'second'], unlink => 1 ),
187 'correct file content',
193 local $Test::Builder::Level = $Test::Builder::Level + 1;
194 my $test = $RT::Handle->dbh->selectall_arrayref(
195 "SELECT id FROM Users WHERE Name = 'Nobody'"
197 ok $test && $test->[0][0], "selected, DB is there";