Bug#1028275: perl: Return value of system()

Sun Jan 15 21:35:11 GMT 2023

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 at 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 dpchrist at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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