Package: perl
Version: 5.32.1-4+deb11u2
Severity: normal
X-Debbugs-Cc: dpchr...@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@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 dpchr...@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@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@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@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@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@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@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@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@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@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@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@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

Reply via email to