rt/t/api/safe-run-child-util.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use RT::Test tests => 35;
   7 use Test::Warn;
   8
   9 use RT::Util qw(safe_run_child);
  10 use POSIX qw//;
  11
  12 is_handle_ok();
  13
  14 {
  15     my $res = safe_run_child { return 1 };
  16     is $res, 1, "correct return value";
  17     is_handle_ok();
  18 }
  19
  20 # test context
  21 {
  22     my $context;
  23     my $sub = sub {
  24         if ( wantarray ) {
  25             $context = 'array'; return 1, 2, 3;
  26         } elsif ( defined wantarray ) {
  27             $context = 'scalar'; return 'foo';
  28         } elsif ( !wantarray ) {
  29             $context = 'void'; return;
  30         }
  31     };
  32     is_deeply [ safe_run_child { $sub->(@_) } ], [1, 2, 3];
  33     is $context, 'array';
  34     is_handle_ok();
  35
  36     is scalar safe_run_child {$sub->(@_)}, 'foo';
  37     is $context, 'scalar';
  38     is_handle_ok();
  39
  40     safe_run_child {$sub->(@_)};
  41     is $context, 'void';
  42     is_handle_ok();
  43 }
  44
  45 # fork+child returns
  46 {
  47     my $res = safe_run_child {
  48         if (fork) { wait; return 'parent' }
  49
  50         open my $fh, '>', RT::Test->temp_directory .'/tttt';
  51         print $fh "child";
  52         close $fh;
  53
  54         return 'child';
  55     };
  56     is $res, 'parent', "correct return value";
  57     is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  58         'child',
  59         'correct file content',
  60     );
  61     is_handle_ok();
  62 }
  63
  64 # fork+child dies
  65 {
  66     warning_like {
  67         my $res = safe_run_child {
  68             if (fork) { wait; return 'parent' }
  69
  70             open my $fh, '>', RT::Test->temp_directory .'/tttt';
  71             print $fh "child";
  72             close $fh;
  73
  74             die 'child';
  75         };
  76         is $res, 'parent', "correct return value";
  77         is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  78             'child',
  79             'correct file content',
  80         );
  81     } qr/System Error: child/;
  82     is_handle_ok();
  83 }
  84
  85 # fork+child exits
  86 {
  87     my $res = safe_run_child {
  88         if (fork) { wait; return 'parent' }
  89
  90         open my $fh, '>', RT::Test->temp_directory .'/tttt';
  91         print $fh "child";
  92         close $fh;
  93
  94         exit 0;
  95     };
  96     is $res, 'parent', "correct return value";
  97     is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  98         'child',
  99         'correct file content',
 100     );
 101     is_handle_ok();
 102 }
 103
 104 # parent dies
 105 {
 106     my $res = eval { safe_run_child { die 'parent'; } };
 107     is $res, undef, "correct return value";
 108     like $@, qr'System Error: parent', "correct error message value";
 109     is_handle_ok();
 110 }
 111
 112 # fork+exec
 113 {
 114     my $script = RT::Test->temp_directory .'/true.pl';
 115     open my $fh, '>', $script;
 116     print $fh <<END;
 117 #!$^X
 118
 119 open my \$fh, '>', '$script.res';
 120 print \$fh "child";
 121 close \$fh;
 122
 123 exit 0;
 124 END
 125     close $fh;
 126     chmod 0777, $script;
 127
 128     my $res = safe_run_child {
 129         if (fork) { wait; return 'parent' }
 130         exec $script;
 131     };
 132     is $res, 'parent', "correct return value";
 133     is( RT::Test->file_content([$script .'.res'], unlink => 1 ),
 134         'child',
 135         'correct file content',
 136     );
 137     is_handle_ok();
 138 }
 139
 140 # fork+parent that doesn't wait()
 141 {
 142     require Time::HiRes;
 143     my $start = Time::HiRes::time();
 144     my $pid;
 145
 146     # Set up a poor man's semaphore
 147     my $all_set = 0;
 148     $SIG{USR1} = sub {$all_set++};
 149
 150     my $res = safe_run_child {
 151         if ($pid = fork) { return 'parent' }
 152
 153         open my $fh, '>', RT::Test->temp_directory .'/first';
 154         print $fh "child";
 155         close $fh;
 156         # Signal that the first file is now all set; we need to do this
 157         # to avoid a race condition
 158         kill POSIX::SIGUSR1(), getppid();
 159
 160         sleep 5;
 161
 162         open $fh, '>', RT::Test->temp_directory .'/second';
 163         print $fh "child";
 164         close $fh;
 165
 166         exit 0;
 167     };
 168     ok( Time::HiRes::time() - $start < 5, "Didn't wait until child finished" );
 169
 170     # Wait for up to 3 seconds to get signaled that the child has made
 171     # the file (the USR1 will break out of the sleep()).  This _should_
 172     # be immediate, but there's a race between the parent and child
 173     # here, since there's no wait()'ing.  There's still a tiny race
 174     # where the signal could come in betwene the $all_set check and the
 175     # sleep, but that just means we sleep for 3 seconds uselessly.
 176     sleep 3 unless $all_set;
 177
 178     is $res, 'parent', "correct return value";
 179     is( RT::Test->file_content([RT::Test->temp_directory, 'first'], unlink => 1 ),
 180         'child',
 181         'correct file content',
 182     );
 183     ok( not(-f RT::Test->temp_directory.'/second'), "Second file does not exist yet");
 184     is_handle_ok();
 185
 186     ok(waitpid($pid,0), "Waited until child finished to reap");
 187     is( RT::Test->file_content([RT::Test->temp_directory, 'second'], unlink => 1 ),
 188         'child',
 189         'correct file content',
 190     );
 191     is_handle_ok();
 192 }
 193
 194 sub is_handle_ok {
 195     local $Test::Builder::Level = $Test::Builder::Level + 1;
 196     my $test = $RT::Handle->dbh->selectall_arrayref(
 197         "SELECT id FROM Users WHERE Name = 'Nobody'"
 198     );
 199     ok $test && $test->[0][0], "selected, DB is there";
 200 }
 201