Bug#1028275: perl: Return value of system()
David Christensen
dpchrist at holgerdanske.com
Mon Jan 9 04:49:49 GMT 2023
Package: perl
Version: 5.32.1-4+deb11u2
Severity: normal
X-Debbugs-Cc: dpchrist at holgerdanske.com
Dear Maintainer,
I am working on some Perl code with child processes and signals.
'perldoc -f system' says:
The return value is the exit status of the program as returned
by the "wait" call.
Reading further, if the child died due to a signal, the signal number
is supposed to be in the bottom 7 bits of $? ($CHILD_ERROR).
Testing shows that system() returns the same value as the value of the
Perl global child error variable $? ($CHILD_ERROR) when the child dies
due to a signal.
Here is a test script:
2023-01-08 20:12:49 dpchrist at laalaa ~/sandbox/perl/signal-child_error
$ nl signal-child_error-system.t
1 #!/usr/bin/env perl
2 # $Id: signal-child_error-system.t,v 1.4 2023/01/09 04:07:32 dpchrist Exp $
3 # by David Paul Christensen dpchrist at holgerdanske.com
4 # Public Domain
5 #
6 # Demonstrates Perl child SIGHUP and $? ($CHILD_ERROR) using system().
7
8 use strict;
9 use warnings;
10 use POSIX qw( SIGHUP );
11 use Test::More;
12
13 isnt $$, 0, join $", __FILE__, __LINE__,
14 sprintf '$$(%i) != 0', $$;
15
16 isnt SIGHUP, 0, join $", __FILE__, __LINE__,
17 sprintf 'SIGHUP(%i) != 0', SIGHUP;
18
19 my $system = system(q( perl -e 'kill "HUP", $$' ));
20
21 is $system, $?, join $", __FILE__, __LINE__,
22 sprintf '$system(%i) == $?(%i)', $system, $?;
23
24 is $?, SIGHUP, join $", __FILE__, __LINE__,
25 sprintf "\$?(%i) == SIGHUP(%i)", $?, SIGHUP;
26
27 my $b15 = ($? >> 15) & 1;
28 my $b14_8 = ($? >> 8) & 127;
29 my $b7 = ($? >> 7) & 1;
30 my $b6_0 = $? & 127;
31
32 is $b15, 0, join $", __FILE__, __LINE__,
33 sprintf "\$b15(%i) == 0", $b15;
34
35 is $b14_8, 0, join $", __FILE__, __LINE__,
36 sprintf "\$b14_8(%i) == 0", $b14_8;
37
38 is $b7, 0, join $", __FILE__, __LINE__,
39 sprintf "\$b7(%i) == 0", $b7;
40
41 is $b6_0, SIGHUP, join $", __FILE__, __LINE__,
42 sprintf "\$b6_0(%i) == SIGHUP(%i)", $b6_0, SIGHUP;
43
44 done_testing;
If I run the test script on Debian:
2023-01-08 20:17:31 dpchrist at laalaa ~/sandbox/perl/signal-child_error
$ 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-08 20:17:41 dpchrist at laalaa ~/sandbox/perl/signal-child_error
$ perl signal-child_error-system.t
ok 1 - signal-child_error-system.t 13 $$(17280) != 0
ok 2 - signal-child_error-system.t 16 SIGHUP(1) != 0
Hangup
ok 3 - signal-child_error-system.t 21 $system(33024) == $?(33024)
not ok 4 - signal-child_error-system.t 24 $?(33024) == SIGHUP(1)
# Failed test 'signal-child_error-system.t 24 $?(33024) == SIGHUP(1)'
# at signal-child_error-system.t line 24.
# got: '33024'
# expected: '1'
not ok 5 - signal-child_error-system.t 32 $b15(1) == 0
# Failed test 'signal-child_error-system.t 32 $b15(1) == 0'
# at signal-child_error-system.t line 32.
# got: '1'
# expected: '0'
not ok 6 - signal-child_error-system.t 35 $b14_8(1) == 0
# Failed test 'signal-child_error-system.t 35 $b14_8(1) == 0'
# at signal-child_error-system.t line 35.
# got: '1'
# expected: '0'
ok 7 - signal-child_error-system.t 38 $b7(0) == 0
not ok 8 - signal-child_error-system.t 41 $b6_0(0) == SIGHUP(1)
# Failed test 'signal-child_error-system.t 41 $b6_0(0) == SIGHUP(1)'
# at signal-child_error-system.t line 41.
# got: '0'
# expected: '1'
1..8
# Looks like you failed 4 tests of 8.
Please note:
- The return value of system() is identical to $? ($CHILD_ERROR)
(line 21).
- This value does not correspond to the signal number (line 24).
- Bit 15 is 1, when it should be 0 (line 32)
- Bits 14-8 contain the signal number, when they should be 0 (line 35).
- Bits 6-0 are 0, when they should contain the signal number (line 41).
If I run the same script on FreeBSD with the same version of Perl:
2023-01-08 20:19:57 dpchrist at f3 ~/sandbox/perl/signal-child_error
$ freebsd-version ; uname -a ; perl -v | head -n 2 | tail -n 1
12.3-RELEASE-p10
FreeBSD f3.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-08 20:20:00 dpchrist at f3 ~/sandbox/perl/signal-child_error
$ grep Id signal-child_error-system.t
# $Id: signal-child_error-system.t,v 1.4 2023/01/09 04:07:32 dpchrist Exp $
2023-01-08 20:20:26 dpchrist at f3 ~/sandbox/perl/signal-child_error
$ perl signal-child_error-system.t
ok 1 - signal-child_error-system.t 13 $$(22264) != 0
ok 2 - signal-child_error-system.t 16 SIGHUP(1) != 0
ok 3 - signal-child_error-system.t 21 $system(1) == $?(1)
ok 4 - signal-child_error-system.t 24 $?(1) == SIGHUP(1)
ok 5 - signal-child_error-system.t 32 $b15(0) == 0
ok 6 - signal-child_error-system.t 35 $b14_8(0) == 0
ok 7 - signal-child_error-system.t 38 $b7(0) == 0
ok 8 - signal-child_error-system.t 41 $b6_0(1) == SIGHUP(1)
1..8
If I run the same script on Windows 7 Pro with Cygwin and the same
version of Perl:
2023-01-08 20:39:13 dpchrist at win7 ~/sandbox/perl/signal-child_error
$ 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-08 20:39:24 dpchrist at win7 ~/sandbox/perl/signal-child_error
$ grep Id signal-child_error-system.t
# $Id: signal-child_error-system.t,v 1.4 2023/01/09 04:07:32 dpchrist Exp $
2023-01-08 20:39:29 dpchrist at win7 ~/sandbox/perl/signal-child_error
$ perl signal-child_error-system.t
ok 1 - signal-child_error-system.t 13 $$(1000) != 0
ok 2 - signal-child_error-system.t 16 SIGHUP(1) != 0
ok 3 - signal-child_error-system.t 21 $system(1) == $?(1)
ok 4 - signal-child_error-system.t 24 $?(1) == SIGHUP(1)
ok 5 - signal-child_error-system.t 32 $b15(0) == 0
ok 6 - signal-child_error-system.t 35 $b14_8(0) == 0
ok 7 - signal-child_error-system.t 38 $b7(0) == 0
ok 8 - signal-child_error-system.t 41 $b6_0(1) == SIGHUP(1)
1..8
If I run the same script on macOS and an earlier version of Perl:
2023-01-08 20:44:21 dpchrist at dpchrist-mbp ~/sandbox/perl/signal-child_error
$ 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-08 20:44:38 dpchrist at dpchrist-mbp ~/sandbox/perl/signal-child_error
$ grep Id signal-child_error-system.t
# $Id: signal-child_error-system.t,v 1.4 2023/01/09 04:07:32 dpchrist Exp $
2023-01-08 20:44:42 dpchrist at dpchrist-mbp ~/sandbox/perl/signal-child_error
$ perl signal-child_error-system.t
ok 1 - signal-child_error-system.t 13 $$(2002) != 0
ok 2 - signal-child_error-system.t 16 SIGHUP(1) != 0
ok 3 - signal-child_error-system.t 21 $system(1) == $?(1)
ok 4 - signal-child_error-system.t 24 $?(1) == SIGHUP(1)
ok 5 - signal-child_error-system.t 32 $b15(0) == 0
ok 6 - signal-child_error-system.t 35 $b14_8(0) == 0
ok 7 - signal-child_error-system.t 38 $b7(0) == 0
ok 8 - signal-child_error-system.t 41 $b6_0(1) == SIGHUP(1)
1..8
David
-- System Information:
Debian Release: 11.6
APT prefers stable-updates
APT policy: (500, 'stable-updates'), (500, 'stable-security'), (500, 'stable')
Architecture: amd64 (x86_64)
Kernel: Linux 5.10.0-20-amd64 (SMP w/8 CPU threads)
Kernel taint flags: TAINT_OOT_MODULE, TAINT_UNSIGNED_MODULE
Locale: LANG=C, LC_CTYPE=C.UTF-8 (charmap=UTF-8), LANGUAGE not set
Shell: /bin/sh linked to /usr/bin/dash
Init: systemd (via /run/systemd/system)
LSM: AppArmor: enabled
Versions of packages perl depends on:
ii dpkg 1.20.12
ii libperl5.32 5.32.1-4+deb11u2
ii perl-base 5.32.1-4+deb11u2
ii perl-modules-5.32 5.32.1-4+deb11u2
Versions of packages perl recommends:
ii netbase 6.3
Versions of packages perl suggests:
pn libtap-harness-archive-perl <none>
pn libterm-readline-gnu-perl | libterm-readline-perl-perl <none>
ii make 4.3-4.1
ii perl-doc 5.32.1-4+deb11u2
-- no debconf information
More information about the Perl-maintainers
mailing list