diff --git a/t/91-segv-fork.t b/t/91-segv-fork.t index baca25d..0f20313 100644 --- a/t/91-segv-fork.t +++ b/t/91-segv-fork.t @@ -101,6 +101,7 @@ package DB::Fork; use strict; use warnings; +use Carp; use Time::HiRes qw| usleep |; use DBI; use Test::More; @@ -109,12 +110,13 @@ use Data::Dumper; use lib 't/lib'; use DBDOracleTestLib qw/ db_handle /; - our $VERSION; our $VERBOSE; our $ENABLED; our $CHILDREN; our $PARENT; +our $SIG_PING; +our $SIG_EXIT; our $ONETHR :shared; @@ -123,6 +125,27 @@ BEGIN { $VERBOSE = $main::VERBOSE || 0; $CHILDREN = []; $PARENT = $$; + $SIG_PING = 'USR1'; + $SIG_EXIT = 'USR2'; + + eval { + local $SIG{__WARN__} = sub + { + croak @_; + }; + + ## Not all OS's support USR1 / USR2 + $SIG_PING = 'USR1'; + $SIG_EXIT = 'USR2'; + local $SIG{$SIG_PING} = sub { 1; }; + local $SIG{$SIG_EXIT} = sub { 1; }; + } or + do { + note "# Using HUP as alternative to unsupported USR1 (PING/ACK)\n"; + note "# Using INT as alternative to unsupported USR2 (EXIT)\n"; + $SIG_PING = 'HUP'; + $SIG_EXIT = 'INT'; + }; # DBI->trace(9); } @@ -204,7 +227,7 @@ sub ping my $olimit = 3 * scalar @ $CHILDREN; my $signaled = {}; - local $SIG{USR1} = sub + local $SIG{$SIG_PING} = sub { return unless $child_pid; $signaled->{$child_pid} = $child_pid; @@ -222,9 +245,9 @@ sub ping last unless $child_pid; - ## USR1 == ping + ## ping usleep 100000; - ok kill( 'USR1', $child_pid ), 'kill USR1(ping) ' . $child_pid; + ok kill( $SIG_PING, $child_pid ), sprintf 'kill %s %d', $SIG_PING, $child_pid; while ( $limit-- && ! exists $signaled->{ $child_pid } ) { @@ -242,8 +265,8 @@ QUEUE_BACKEND: my $do_ping; my $do_exit; - sub _USER1 { printf "# USR1=PING on-child=%d received\n", $$; return ( $do_ping = 1 ); } - sub _USER2 { printf "# USR2=EXIT on-child=%d received\n", $$; return ( $do_exit = 1 ); } + sub _USER1 { printf "# %s=PING on-child=%d received\n", $SIG_PING, $$; return ( $do_ping = 1 ); } + sub _USER2 { printf "# %s=EXIT on-child=%d received\n", $SIG_EXIT, $$; return ( $do_exit = 1 ); } sub _FORK_WORKER { @@ -251,8 +274,8 @@ QUEUE_BACKEND: printf "# PID=%d (START)\n", $$; - local $SIG{USR1} = \&_USER1; - local $SIG{USR2} = \&_USER2; + local $SIG{$SIG_PING} = \&_USER1; + local $SIG{$SIG_EXIT} = \&_USER2; BUSY: while (1) @@ -262,7 +285,8 @@ QUEUE_BACKEND: { printf "# pid=%s PING received (hold on, this is going to be a bumpy ride!)\n", $$; _connect(); - printf "# PARENT=%s CHILD=%d %s=kill USR1\n", $PARENT, $$, kill( 'USR1', $PARENT ); + ## AKA PING-ACK + printf "# PARENT=%s CHILD=%d %s=kill %s\n", $PARENT, $$, kill( $SIG_PING, $PARENT ), $SIG_PING; $do_ping = 0; next; } diff --git a/t/92-segv-fork.pl b/t/92-segv-fork.pl index 8516416..b7faef5 100755 --- a/t/92-segv-fork.pl +++ b/t/92-segv-fork.pl @@ -51,7 +51,7 @@ exit(6) unless scalar @ $row == 1; # printf "# [ %s ]\n", $row->[]; -my $usleep = int(rand(300000)) + 2000000; # 2-5 seconds +my $usleep = int(rand(100000)) + 2000000; # 1-3 seconds (to speed up test!) # printf "# %02.2f seconds\n", $usleep / 1000000; usleep($usleep); diff --git a/t/92-segv-fork.t b/t/92-segv-fork.t index 3d03c99..0f9a250 100644 --- a/t/92-segv-fork.t +++ b/t/92-segv-fork.t @@ -1,5 +1,13 @@ #!/usr/bin/env perl +## A SEGV during this test is a sign that Perl itself lacks the patch +## that allows a SIGCHLD (any interrupt) to be handedled using a worker +## thread created by Oracle Instant Client. +## +## Consult: https://github.com/perl5-dbi/DBD-Oracle/issues/192 +## and: https://github.com/Perl/perl5/issues/23326 +## for details concerning the issue and the patch. + use strict; use warnings; use Time::HiRes qw| usleep |; @@ -73,6 +81,7 @@ ORACLE_READY: } $dbh = undef; # Not important but an indication SEGV is eminent + # (wont't PASS if Perl is not built with threads support) # bark_thread_count(2); } @@ -106,12 +115,10 @@ QUEUE_BASICS: FORK_SEGV: { -# last FORK_SEGV if 1; - section 'FORK - SEGV'; my $queue = Child::Queue->new( -DEPTH => 8 ); - my $jobs = 80; + my $jobs = 40; is $queue->depth, 8, 'Queue depth'; is $queue->size, 0, 'Queue size';