Upgrade Test::Simple from version 1.302056 to 1.302059

[perl5.git] / cpan / Test-Simple / lib / Test2 / API / Instance.pm

diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm
index f73e399..556cad1 100644 (file)
--- a/cpan/Test-Simple/lib/Test2/API/Instance.pm
+++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm
@@ -2,7 +2,7 @@ package Test2::API::Instance;
 use strict;
 use warnings;
 
-our $VERSION = '1.302015';
+our $VERSION = '1.302059';
 
 
 our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
@@ -15,7 +15,7 @@ use Test2::Util::Trace();
 use Test2::API::Stack();
 
 use Test2::Util::HashBase qw{
-    pid tid
+    _pid _tid
     no_wait
     finalized loaded
     ipc stack formatter
@@ -35,6 +35,9 @@ use Test2::Util::HashBase qw{
     context_release_callbacks
 };
 
+sub pid { $_[0]->{+_PID} ||= $$ }
+sub tid { $_[0]->{+_TID} ||= get_tid() }
+
 # Wrap around the getters that should call _finalize.
 BEGIN {
     for my $finalizer (IPC, FORMATTER) {
@@ -63,8 +66,9 @@ sub init { $_[0]->reset }
 sub reset {
     my $self = shift;
 
-    $self->{+PID} = $$;
-    $self->{+TID} = get_tid();
+    delete $self->{+_PID};
+    delete $self->{+_TID};
+
     $self->{+CONTEXTS}    = {};
 
     $self->{+IPC_DRIVERS} = [];
@@ -95,6 +99,9 @@ sub _finalize {
 
     $self->{+FINALIZED} = $caller;
 
+    $self->{+_PID} = $$        unless defined $self->{+_PID};
+    $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
     unless ($self->{+FORMATTER}) {
         my ($formatter, $source);
         if ($ENV{T2_FORMATTER}) {
@@ -129,7 +136,7 @@ sub _finalize {
         $self->{+FORMATTER} = $formatter;
     }
 
-    # Turn on IPC if threads are on, drivers are reigstered, or the Test2::IPC
+    # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC
     # module is loaded.
     return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}};
 
@@ -220,6 +227,9 @@ sub add_post_load_callback {
 sub load {
     my $self = shift;
     unless ($self->{+LOADED}) {
+        $self->{+_PID} = $$        unless defined $self->{+_PID};
+        $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
         # This is for https://github.com/Test-More/test-more/issues/16
         # and https://rt.perl.org/Public/Bug/Display.html?id=127774
         # END blocks run in reverse order. This insures the END block is loaded
@@ -260,6 +270,9 @@ sub add_ipc_driver {
 sub enable_ipc_polling {
     my $self = shift;
 
+    $self->{+_PID} = $$        unless defined $self->{+_PID};
+    $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
     $self->add_context_init_callback(
         # This is called every time a context is created, it needs to be fast.
         # $_[0] is a context object
@@ -287,6 +300,9 @@ sub ipc_enable_shm {
 
     return 1 if defined $self->{+IPC_SHM_ID};
 
+    $self->{+_PID} = $$        unless defined $self->{+_PID};
+    $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
     my ($ok, $err) = try {
         require IPC::SysV;
 
@@ -346,14 +362,16 @@ sub disable_ipc_polling {
 sub _ipc_wait {
     my $fail = 0;
 
-    while (CAN_FORK) {
-        my $pid = CORE::wait();
-        my $err = $?;
-        last if $pid == -1;
-        next unless $err;
-        $fail++;
-        $err = $err >> 8;
-        warn "Process $pid did not exit cleanly (status: $err)\n";
+    if (CAN_FORK) {
+        while (1) {
+            my $pid = CORE::wait();
+            my $err = $?;
+            last if $pid == -1;
+            next unless $err;
+            $fail++;
+            $err = $err >> 8;
+            warn "Process $pid did not exit cleanly (status: $err)\n";
+        }
     }
 
     if (USE_THREADS) {
@@ -377,8 +395,8 @@ sub _ipc_wait {
 sub DESTROY {
     my $self = shift;
 
-    return unless $self->{+PID} == $$;
-    return unless $self->{+TID} == get_tid();
+    return unless defined($self->{+_PID}) && $self->{+_PID} == $$;
+    return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid();
 
     shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0)
         if defined $self->{+IPC_SHM_ID};
@@ -413,7 +431,7 @@ This is not a supported configuration, you will have problems.
 
         # Only worry about contexts in this PID
         my $trace = $ctx->trace || next;
-        next unless $trace->pid == $$;
+        next unless $trace->pid && $trace->pid == $$;
 
         # Do not worry about contexts that have no hub
         my $hub = $ctx->hub  || next;
@@ -429,7 +447,7 @@ This is not a supported configuration, you will have problems.
         $new_exit = 255;
     }
 
-    if ($self->{+PID} != $$ or $self->{+TID} != get_tid()) {
+    if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) {
         $? = $exit;
         return;
     }
@@ -475,8 +493,7 @@ This is not a supported configuration, you will have problems.
 
     $new_exit = 255 if $new_exit > 255;
 
-    if ($new_exit) {
-        require Test2::API::Breakage;
+    if ($new_exit && eval { require Test2::API::Breakage; 1 }) {
         my @warn = Test2::API::Breakage->report();
 
         if (@warn) {
@@ -547,7 +564,7 @@ Get the post-load callbacks.
 =item $obj->add_post_load_callback(sub { ... })
 
 Add a post-load callback. If C<load()> has already been called then the callback will
-be immedietly executed. If C<load()> has not been called then the callback will be
+be immediately executed. If C<load()> has not been called then the callback will be
 stored and executed later when C<load()> is called.
 
 =item $hashref = $obj->contexts()