1From 75d974a58c461b3b5d35280e497810e46abae4ca Mon Sep 17 00:00:00 2001
2From: William Lyu <William.Lyu@windriver.com>
3Date: Wed, 4 Oct 2023 08:58:41 -0400
4Subject: [PATCH] Fix intermittent failure of test t/op/sigsystem.t
5
6[Perl issue #21546] -- https://github.com/Perl/perl5/issues/21546
7
8This fix addresses the intermittent failure of the test
9t/op/sigsystem.t by improving its robustness. Before the fix, this
10test waits a hard-coded amount of time in the parent process for the
11child process to exit, and the child process may not be able to exit
12soon enough. With this fix, the parent process in this test polls for
13whether the SIGCHLD handler reaped the child process for at most 25
14seconds.
15
16Upstream-Status: Backport [commit ID: 75d974a]
17
18Signed-off-by: William Lyu <William.Lyu@windriver.com>
19Signed-off-by: Randy MacLeod <randy.macleod@windriver.com>
20Reported-by: Alexandre Belloni <alexandre.belloni@bootlin.com>
21
22Committer: William Lyu is now a Perl author.
23---
24 AUTHORS          |  1 +
25 t/op/sigsystem.t | 17 ++++++++++++++---
26 2 files changed, 15 insertions(+), 3 deletions(-)
27
28diff --git a/AUTHORS b/AUTHORS
29index 21948bfdc7..527dd992fd 100644
30--- a/AUTHORS
31+++ b/AUTHORS
32@@ -1443,6 +1443,7 @@ Wayne Scott                    <wscott@ichips.intel.com>
33 Wayne Thompson                 <Wayne.Thompson@Ebay.sun.com>
34 Wilfredo Sánchez               <wsanchez@mit.edu>
35 William J. Middleton           <William.Middleton@oslo.mobil.telenor.no>
36+William Lyu                    <William.Lyu@windriver.com>
37 William Mann                   <wmann@avici.com>
38 William Middleton              <wmiddlet@adobe.com>
39 William R Ward                 <hermit@BayView.COM>
40diff --git a/t/op/sigsystem.t b/t/op/sigsystem.t
41index 25da854902..831feefb0f 100644
42--- a/t/op/sigsystem.t
43+++ b/t/op/sigsystem.t
44@@ -37,7 +37,15 @@ SKIP: {
45     test_system('with reaper');
46
47     note("Waiting briefly for SIGCHLD...");
48-    Time::HiRes::sleep(0.500);
49+
50+    # Wait at most 50 * 0.500 = 25.0 seconds for the child process to be
51+    # reaped. If the child process exits and gets reaped early, this polling
52+    # loop will exit early.
53+
54+    for (1..50) {
55+	last if @pids;
56+	Time::HiRes::sleep(0.500);
57+    }
58
59     ok(@pids == 1, 'Reaped only one process');
60     ok($pids[0] == $pid, "Reaped the right process.") or diag(Dumper(\@pids));
61@@ -50,8 +58,11 @@ sub test_system {
62     my $got_zeroes      = 0;
63
64     # This test is looking for a race between system()'s waitpid() and a
65-    # signal handler.    Looping a few times increases the chances of
66-    # catching the error.
67+    # signal handler. The system() call is expected to not interfere with the
68+    # SIGCHLD signal handler. In particular, the wait() called within system()
69+    # is expected to reap the child process forked by system() before the
70+    # SIGCHLD signal handler is called.
71+    # Looping a few times increases the chances of catching the error.
72
73     for (1..$expected_zeroes) {
74 	$got_zeroes++ unless system(TRUE);
75--
762.25.1
77
78