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

   1 use strict;
   2 use warnings;
   3
   4 use RT::Test tests => 35;
   5 use Test::Warn;
   6
   7 use RT::Util qw(safe_run_child);
   8 use POSIX qw//;
   9
  10 is_handle_ok();
  11
  12 {
  13     my $res = safe_run_child { return 1 };
  14     is $res, 1, "correct return value";
  15     is_handle_ok();
  16 }
  17
  18 # test context
  19 {
  20     my $context;
  21     my $sub = sub {
  22         if ( wantarray ) {
  23             $context = 'array'; return 1, 2, 3;
  24         } elsif ( defined wantarray ) {
  25             $context = 'scalar'; return 'foo';
  26         } elsif ( !wantarray ) {
  27             $context = 'void'; return;
  28         }
  29     };
  30     is_deeply [ safe_run_child { $sub->(@_) } ], [1, 2, 3];
  31     is $context, 'array';
  32     is_handle_ok();
  33
  34     is scalar safe_run_child {$sub->(@_)}, 'foo';
  35     is $context, 'scalar';
  36     is_handle_ok();
  37
  38     safe_run_child {$sub->(@_)};
  39     is $context, 'void';
  40     is_handle_ok();
  41 }
  42
  43 # fork+child returns
  44 {
  45     my $res = safe_run_child {
  46         if (fork) { wait; return 'parent' }
  47
  48         open my $fh, '>', RT::Test->temp_directory .'/tttt';
  49         print $fh "child";
  50         close $fh;
  51
  52         return 'child';
  53     };
  54     is $res, 'parent', "correct return value";
  55     is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  56         'child',
  57         'correct file content',
  58     );
  59     is_handle_ok();
  60 }
  61
  62 # fork+child dies
  63 {
  64     warning_like {
  65         my $res = safe_run_child {
  66             if (fork) { wait; return 'parent' }
  67
  68             open my $fh, '>', RT::Test->temp_directory .'/tttt';
  69             print $fh "child";
  70             close $fh;
  71
  72             die 'child';
  73         };
  74         is $res, 'parent', "correct return value";
  75         is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  76             'child',
  77             'correct file content',
  78         );
  79     } qr/System Error: child/;
  80     is_handle_ok();
  81 }
  82
  83 # fork+child exits
  84 {
  85     my $res = safe_run_child {
  86         if (fork) { wait; return 'parent' }
  87
  88         open my $fh, '>', RT::Test->temp_directory .'/tttt';
  89         print $fh "child";
  90         close $fh;
  91
  92         exit 0;
  93     };
  94     is $res, 'parent', "correct return value";
  95     is( RT::Test->file_content([RT::Test->temp_directory, 'tttt'], unlink => 1 ),
  96         'child',
  97         'correct file content',
  98     );
  99     is_handle_ok();
 100 }
 101
 102 # parent dies
 103 {
 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";
 107     is_handle_ok();
 108 }
 109
 110 # fork+exec
 111 {
 112     my $script = RT::Test->temp_directory .'/true.pl';
 113     open my $fh, '>', $script;
 114     print $fh <<END;
 115 #!$^X
 116
 117 open my \$fh, '>', '$script.res';
 118 print \$fh "child";
 119 close \$fh;
 120
 121 exit 0;
 122 END
 123     close $fh;
 124     chmod 0777, $script;
 125
 126     my $res = safe_run_child {
 127         if (fork) { wait; return 'parent' }
 128         exec $script;
 129     };
 130     is $res, 'parent', "correct return value";
 131     is( RT::Test->file_content([$script .'.res'], unlink => 1 ),
 132         'child',
 133         'correct file content',
 134     );
 135     is_handle_ok();
 136 }
 137
 138 # fork+parent that doesn't wait()
 139 {
 140     require Time::HiRes;
 141     my $start = Time::HiRes::time();
 142     my $pid;
 143
 144     # Set up a poor man's semaphore
 145     my $all_set = 0;
 146     $SIG{USR1} = sub {$all_set++};
 147
 148     my $res = safe_run_child {
 149         if ($pid = fork) { return 'parent' }
 150
 151         open my $fh, '>', RT::Test->temp_directory .'/first';
 152         print $fh "child";
 153         close $fh;
 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();
 157
 158         sleep 5;
 159
 160         open $fh, '>', RT::Test->temp_directory .'/second';
 161         print $fh "child";
 162         close $fh;
 163
 164         exit 0;
 165     };
 166     ok( Time::HiRes::time() - $start < 5, "Didn't wait until child finished" );
 167
 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;
 175
 176     is $res, 'parent', "correct return value";
 177     is( RT::Test->file_content([RT::Test->temp_directory, 'first'], unlink => 1 ),
 178         'child',
 179         'correct file content',
 180     );
 181     ok( not(-f RT::Test->temp_directory.'/second'), "Second file does not exist yet");
 182     is_handle_ok();
 183
 184     ok(waitpid($pid,0), "Waited until child finished to reap");
 185     is( RT::Test->file_content([RT::Test->temp_directory, 'second'], unlink => 1 ),
 186         'child',
 187         'correct file content',
 188     );
 189     is_handle_ok();
 190 }
 191
 192 sub is_handle_ok {
 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'"
 196     );
 197     ok $test && $test->[0][0], "selected, DB is there";
 198 }
 199