Debian bug 1028275:
I have expanded my test script to test Perl's built-in system() with a
single argument and with a list of arguments.
HTH,
David
2023-01-15 13:07:34 dpchrist@laalaa ~/sandbox/perl
$ cat system.t
#!/usr/bin/env perl
# $Id: system.t,v 1.5 2023/01/15 21:07:33 dpchrist Exp $
# by David Paul Christensen dpchr...@holgerdanske.com
# Public Domain
#
# Test Perl built-in system().
use strict;
use warnings;
use Capture::Tiny qw( capture );
use POSIX qw( SIGUSR2 );
use Test::More;
use Test::Warn;
our @args;
our $stdout;
our $stderr;
our $system;
our $ce;
our $TODO;
sub _t
{
note shift;
local @args = @{ shift @_ };
my $a = shift;
note "\@args='", join("', '", @args), "'";
($stdout, $stderr, $system) = capture { system(@args) };
$ce = $?;
$_->() for @_;
local @args = ($a);
note "\@args='", join("', '", @args), "'";
($stdout, $stderr, $system) = capture { system(@args) };
$ce = $?;
$_->() for @_;
}
_t(@$_) for (
[
"Child failed to execute",
[qw( nosuchprogram foo bar )],
q(nosuchprogram foo bar),
sub {
eval {
is $stdout, '', join $", __FILE__, __LINE__,
'STDOUT is empty string';
like
$stderr,
qr/^Can't exec "nosuchprogram": No such file or directory/,
join $", __FILE__, __LINE__,
q(STDERR like /Can't exec "nosuchprogram": No such file or
directory/);
is $system, $ce, join $", __FILE__, __LINE__,
sprintf 'System return value (0x%X) is $CHILD_ERROR (0x%X)',
$system,
$ce;
is $ce, -1, join $", __FILE__, __LINE__,
sprintf '$CHILD_ERROR (0x%X) is -1',
$ce;
is $ce & 127, 0x7F, join $", __FILE__, __LINE__,
sprintf 'Lower 7 bits of $CHILD_ERROR (0x%X) are ones',
$ce & 127;
is $ce >> 8, (~0) >> 8, join $", __FILE__, __LINE__,
sprintf 'Upper bytes of $CHILD_ERROR (0x%X) are ones',
$ce >> 8;
};
},
],
[
"Child kills itself with signal USR2",
['perl', '-e', 'kill "USR2", $$'],
q(perl -e 'kill "USR2", $$'),
sub {
eval {
is $system, $ce, join $", __FILE__, __LINE__,
sprintf 'System return value (0x%X) is $CHILD_ERROR (0x%X)',
$system,
$ce;
isnt $ce, -1, join $", __FILE__, __LINE__,
sprintf '$CHILD_ERROR (0x%X) isnt -1',
$ce;
};
},
sub {
my $code = q{
is $ce & 127, SIGUSR2, join $", __FILE__, __LINE__,
sprintf 'Lower 7 bits of $CHILD_ERROR (0x%X) is SIGUSR2 (0x%X)',
$ce & 127,
SIGUSR2;
is $ce >> 8, 0, join $", __FILE__, __LINE__,
sprintf 'Upper bytes of $CHILD_ERROR (0x%X) are zeroes',
$ce >> 8;
};
if (@args == 1 && -e '/etc/debian_version') {
TODO: {
local $TODO =
"https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1028275";;
eval $code;
}
}
else {
eval $code;
}
},
],
[
"Child exits with value 0xA5",
['perl', '-e', 'exit 0xA5'],
q(perl -e 'exit 0xA5'),
sub {
eval {
is $system, $ce, join $", __FILE__, __LINE__,
sprintf 'System return value (0x%X) is $CHILD_ERROR (0x%X)',
$system,
$ce;
isnt $ce, -1, join $", __FILE__, __LINE__,
sprintf '$CHILD_ERROR (0x%X) isnt -1',
$ce;
is $ce & 127, 0, join $", __FILE__, __LINE__,
sprintf 'Lower 7 bits of $CHILD_ERROR (0x%X) are zeroes',
$ce & 127;
is $ce >> 8, 0xA5, join $", __FILE__, __LINE__,
sprintf 'Upper bytes of $CHILD_ERROR (0x%X) is 0xA5',
$ce >> 8;
};
},
],
);
done_testing;
2023-01-15 13:24:04 dpchrist@laalaa ~/sandbox/perl
$ cat /etc/debian_version ; uname -a ; perl -v | head -n 2 | tail -n 1
11.6
Linux laalaa 5.10.0-20-amd64 #1 SMP Debian 5.10.158-2 (2022-12-13)
x86_64 GNU/Linux
This is perl 5, version 32, subversion 1 (v5.32.1) built for
x86_64-linux-gnu-thread-multi
2023-01-15 13:24:09 dpchrist@laalaa ~/sandbox/perl
$ perl system.t
# Child failed to execute
# @args='nosuchprogram', 'foo', 'bar'
ok 1 - system.t 50 STDOUT is empty string
ok 2 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 3 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 4 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 5 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 6 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# @args='nosuchprogram foo bar'
ok 7 - system.t 50 STDOUT is empty string
ok 8 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 9 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 10 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 11 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 12 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# Child kills itself with signal USR2
# @args='perl', '-e', 'kill "USR2", $$'
ok 13 - system.t 85 System return value (0xC) is $CHILD_ERROR (0xC)
ok 14 - system.t 91 $CHILD_ERROR (0xC) isnt -1
ok 15 - (eval 35) 2 Lower 7 bits of $CHILD_ERROR (0xC) is SIGUSR2 (0xC)
ok 16 - (eval 35) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# @args='perl -e 'kill "USR2", $$''
ok 17 - system.t 85 System return value (0x8C00) is $CHILD_ERROR (0x8C00)
ok 18 - system.t 91 $CHILD_ERROR (0x8C00) isnt -1
not ok 19 - (eval 40) 2 Lower 7 bits of $CHILD_ERROR (0x0) is SIGUSR2
(0xC) # TODO https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1028275
# Failed (TODO) test '(eval 40) 2 Lower 7 bits of $CHILD_ERROR (0x0)
is SIGUSR2 (0xC)'
# at (eval 40) line 2.
# got: '0'
# expected: '12'
not ok 20 - (eval 40) 7 Upper bytes of $CHILD_ERROR (0x8C) are zeroes #
TODO https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1028275
# Failed (TODO) test '(eval 40) 7 Upper bytes of $CHILD_ERROR (0x8C)
are zeroes'
# at (eval 40) line 7.
# got: '140'
# expected: '0'
# Child exits with value 0xA5
# @args='perl', '-e', 'exit 0xA5'
ok 21 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 22 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 23 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 24 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
# @args='perl -e 'exit 0xA5''
ok 25 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 26 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 27 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 28 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
1..28
2023-01-15 13:19:38 dpchrist@samba /var/local/samba/dpchrist/sandbox/perl
$ freebsd-version ; uname -a ; perl -v | head -n 2 | tail -n 1
12.3-RELEASE-p10
FreeBSD samba.tracy.holgerdanske.com 12.3-RELEASE-p6 FreeBSD
12.3-RELEASE-p6 GENERIC amd64
This is perl 5, version 32, subversion 1 (v5.32.1) built for
amd64-freebsd-thread-multi
2023-01-15 13:31:23 dpchrist@samba /var/local/samba/dpchrist/sandbox/perl
$ perl system.t
# Child failed to execute
# @args='nosuchprogram', 'foo', 'bar'
ok 1 - system.t 50 STDOUT is empty string
ok 2 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 3 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 4 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 5 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 6 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# @args='nosuchprogram foo bar'
ok 7 - system.t 50 STDOUT is empty string
ok 8 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 9 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 10 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 11 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 12 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# Child kills itself with signal USR2
# @args='perl', '-e', 'kill "USR2", $$'
ok 13 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 14 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 15 - (eval 35) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 16 - (eval 35) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# @args='perl -e 'kill "USR2", $$''
ok 17 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 18 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 19 - (eval 40) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 20 - (eval 40) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# Child exits with value 0xA5
# @args='perl', '-e', 'exit 0xA5'
ok 21 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 22 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 23 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 24 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
# @args='perl -e 'exit 0xA5''
ok 25 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 26 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 27 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 28 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
1..28
2023-01-15 13:31:57 dpchrist@dpchrist-mbp ~/sandbox/perl
$ uname -a ; perl -v | head -n 2 | tail -n 1
Darwin dpchrist-mbp 21.6.0 Darwin Kernel Version 21.6.0: Mon Aug 22
20:17:10 PDT 2022; root:xnu-8020.140.49~2/RELEASE_X86_64 x86_64
This is perl 5, version 30, subversion 3 (v5.30.3) built for
darwin-thread-multi-2level
2023-01-15 13:32:08 dpchrist@dpchrist-mbp ~/sandbox/perl
$ perl system.t
# Child failed to execute
# @args='nosuchprogram', 'foo', 'bar'
ok 1 - system.t 50 STDOUT is empty string
ok 2 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 3 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 4 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 5 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 6 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# @args='nosuchprogram foo bar'
ok 7 - system.t 50 STDOUT is empty string
ok 8 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 9 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 10 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 11 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 12 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# Child kills itself with signal USR2
# @args='perl', '-e', 'kill "USR2", $$'
ok 13 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 14 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 15 - (eval 36) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 16 - (eval 36) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# @args='perl -e 'kill "USR2", $$''
ok 17 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 18 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 19 - (eval 41) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 20 - (eval 41) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# Child exits with value 0xA5
# @args='perl', '-e', 'exit 0xA5'
ok 21 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 22 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 23 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 24 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
# @args='perl -e 'exit 0xA5''
ok 25 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 26 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 27 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 28 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
1..28
2023-01-15 13:32:40 dpchrist@win7 ~/sandbox/perl
$ uname -a ; perl -v | head -n 2 | tail -n 1
CYGWIN_NT-6.1-7601 win7 3.3.6-341.x86_64 2022-09-05 11:15 UTC x86_64 Cygwin
This is perl 5, version 32, subversion 1 (v5.32.1) built for
x86_64-cygwin-threads-multi
2023-01-15 13:32:52 dpchrist@win7 ~/sandbox/perl
$ perl system.t
# Child failed to execute
# @args='nosuchprogram', 'foo', 'bar'
ok 1 - system.t 50 STDOUT is empty string
ok 2 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 3 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 4 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 5 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 6 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# @args='nosuchprogram foo bar'
ok 7 - system.t 50 STDOUT is empty string
ok 8 - system.t 56 STDERR like /Can't exec "nosuchprogram": No such file
or directory/
ok 9 - system.t 59 System return value (0xFFFFFFFFFFFFFFFF) is
$CHILD_ERROR (0xFFFFFFFFFFFFFFFF)
ok 10 - system.t 64 $CHILD_ERROR (0xFFFFFFFFFFFFFFFF) is -1
ok 11 - system.t 68 Lower 7 bits of $CHILD_ERROR (0x7F) are ones
ok 12 - system.t 72 Upper bytes of $CHILD_ERROR (0xFFFFFFFFFFFFFF) are ones
# Child kills itself with signal USR2
# @args='perl', '-e', 'kill "USR2", $$'
ok 13 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 14 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 15 - (eval 35) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 16 - (eval 35) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# @args='perl -e 'kill "USR2", $$''
ok 17 - system.t 85 System return value (0x1F) is $CHILD_ERROR (0x1F)
ok 18 - system.t 91 $CHILD_ERROR (0x1F) isnt -1
ok 19 - (eval 40) 2 Lower 7 bits of $CHILD_ERROR (0x1F) is SIGUSR2 (0x1F)
ok 20 - (eval 40) 7 Upper bytes of $CHILD_ERROR (0x0) are zeroes
# Child exits with value 0xA5
# @args='perl', '-e', 'exit 0xA5'
ok 21 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 22 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 23 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 24 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
# @args='perl -e 'exit 0xA5''
ok 25 - system.t 125 System return value (0xA500) is $CHILD_ERROR (0xA500)
ok 26 - system.t 130 $CHILD_ERROR (0xA500) isnt -1
ok 27 - system.t 134 Lower 7 bits of $CHILD_ERROR (0x0) are zeroes
ok 28 - system.t 138 Upper bytes of $CHILD_ERROR (0xA5) is 0xA5
1..28
