Upgrade to threads::shared 1.38

2 files changed, 430 insertions, 1 deletions

diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm
index 1893061811..aa3849e68a 100644
--- a/dist/threads-shared/lib/threads/shared.pm
+++ b/dist/threads-shared/lib/threads/shared.pm
@@ -187,7 +187,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.37
+This document describes threads::shared version 1.38
 
 =head1 SYNOPSIS
 
@@ -527,6 +527,32 @@ that the contents of hash-based objects will be lost due to the above
 mentioned limitation.  See F<examples/class.pl> (in the CPAN distribution of
 this module) for how to create a class that supports object sharing.
 
+When storing shared objects in other shared structures, remove objects from
+the structure using C<delete> (for arrays and hashes) or C<pop> (for arrays)
+in order to ensure the object's destructor is called, if needed.
+
+  # Add shared objects to shared hash
+  my %hsh : shared;
+  $hsh{'obj1'} = SharedObj->new();
+  $hsh{'obj2'} = SharedObj->new();
+  $hsh{'obj3'} = SharedObj->new();
+
+  # Remove object from hash
+  delete($hsh{'obj1'});      # First object's destructor is called
+  $hsh{'obj2'} = undef;      # Second object's destructor is NOT called
+  %hsh = ();                 # Third object's destructor is NOT called
+
+  # Add shared objects to shared array
+  my @arr : shared;
+  $arr[0] = SharedObj->new();
+  $arr[1] = SharedObj->new();
+  $arr[2] = SharedObj->new();
+
+  # Remove object from array
+  pop(@arr);            # Third object's destructor is called
+  $arr[1] = undef;      # Second object's destructor is NOT called
+  undef(@arr);          # First object's destructor is NOT called
+
 Does not support C<splice> on arrays.  Does not support explicitly changing
 array lengths via $#array -- use C<push> and C<pop> instead.
 
diff --git a/dist/threads-shared/t/object2.t b/dist/threads-shared/t/object2.t
new file mode 100644
index 0000000000..b1eafd7ec2
--- /dev/null
+++ b/dist/threads-shared/t/object2.t
@@ -0,0 +1,403 @@
+use strict;
+use warnings;
+
+BEGIN {
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+    if ($] < 5.010) {
+        print("1..0 # SKIP Needs Perl 5.10.0 or later\n");
+        exit(0);
+    }
+}
+
+use ExtUtils::testlib;
+
+BEGIN {
+    $| = 1;
+    print("1..121\n");   ### Number of tests that will be run ###
+};
+
+use threads;
+use threads::shared;
+
+my $TEST;
+BEGIN {
+    share($TEST);
+    $TEST = 1;
+}
+
+sub ok {
+    my ($ok, $name) = @_;
+
+    lock($TEST);
+    my $id = $TEST++;
+
+    # You have to do it this way or VMS will get confused.
+    if ($ok) {
+        print("ok $id - $name\n");
+    } else {
+        print("not ok $id - $name\n");
+        printf("# Failed test at line %d\n", (caller)[2]);
+    }
+
+    return ($ok);
+}
+
+ok(1, 'Loaded');
+
+### Start of Testing ###
+
+my $ID = -1;
+my (@created, @destroyed);
+
+{ package HashObj;
+   sub new {
+       my $class = shift;
+       my $self = &threads::shared::share({});
+       $$self{'ID'} = ++$ID;
+       $created[$ID] = 1;
+       return bless($self, $class);
+   }
+
+   sub DESTROY {
+       my $self = shift;
+       $destroyed[$$self{'ID'}] = 1;
+   }
+}
+
+{ package AryObj;
+   sub new {
+       my $class = shift;
+       my $self = &threads::shared::share([]);
+       $$self[0] = ++$ID;
+       $created[$ID] = 1;
+       return bless($self, $class);
+   }
+
+   sub DESTROY {
+       my $self = shift;
+       $destroyed[$$self[0]] = 1;
+   }
+}
+
+{ package SclrObj;
+   sub new {
+       my $class = shift;
+       my $self = \do{ my $scalar = ++$ID; };
+       $created[$ID] = 1;
+       threads::shared::share($self);
+       return bless($self, $class);
+   }
+
+   sub DESTROY {
+       my $self = shift;
+       $destroyed[$$self] = 1;
+   }
+}
+
+# Testing with normal array
+my @normal_ary;
+
+# Testing with hash object
+$normal_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in normal array');
+delete($normal_ary[0]);
+ok($destroyed[$ID], 'Deleted hash object in normal array');
+
+$normal_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in normal array');
+$normal_ary[0] = undef;
+ok($destroyed[$ID], 'Undef hash object in normal array');
+
+$normal_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in normal array');
+$normal_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in normal array');
+ok($destroyed[$ID-1], 'Replaced hash object in normal array');
+@normal_ary = ();
+ok($destroyed[$ID], 'Hash object removed from cleared normal array');
+
+$normal_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in normal array');
+undef(@normal_ary);
+ok($destroyed[$ID], 'Hash object removed from undef normal array');
+
+# Testing with array object
+$normal_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in normal array');
+delete($normal_ary[0]);
+ok($destroyed[$ID], 'Deleted array object in normal array');
+
+$normal_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in normal array');
+$normal_ary[0] = undef;
+ok($destroyed[$ID], 'Undef array object in normal array');
+
+$normal_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in normal array');
+$normal_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in normal array');
+ok($destroyed[$ID-1], 'Replaced array object in normal array');
+@normal_ary = ();
+ok($destroyed[$ID], 'Array object removed from cleared normal array');
+
+$normal_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in normal array');
+undef(@normal_ary);
+ok($destroyed[$ID], 'Array object removed from undef normal array');
+
+# Testing with scalar object
+$normal_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal array');
+delete($normal_ary[0]);
+ok($destroyed[$ID], 'Deleted scalar object in normal array');
+
+$normal_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal array');
+$normal_ary[0] = undef;
+ok($destroyed[$ID], 'Undef scalar object in normal array');
+
+$normal_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal array');
+$normal_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal array');
+ok($destroyed[$ID-1], 'Replaced scalar object in normal array');
+@normal_ary = ();
+ok($destroyed[$ID], 'Scalar object removed from cleared normal array');
+
+$normal_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal array');
+undef(@normal_ary);
+ok($destroyed[$ID], 'Scalar object removed from undef normal array');
+
+# Testing with normal hash
+my %normal_hash;
+
+# Testing with hash object
+$normal_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in normal hash');
+delete($normal_hash{'obj'});
+ok($destroyed[$ID], 'Deleted hash object in normal hash');
+
+$normal_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in normal hash');
+$normal_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef hash object in normal hash');
+
+$normal_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in normal hash');
+$normal_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in normal hash');
+ok($destroyed[$ID-1], 'Replaced hash object in normal hash');
+%normal_hash = ();
+ok($destroyed[$ID], 'Hash object removed from cleared normal hash');
+
+$normal_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in normal hash');
+undef(%normal_hash);
+ok($destroyed[$ID], 'Hash object removed from undef normal hash');
+
+# Testing with array object
+$normal_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in normal hash');
+delete($normal_hash{'obj'});
+ok($destroyed[$ID], 'Deleted array object in normal hash');
+
+$normal_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in normal hash');
+$normal_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef array object in normal hash');
+
+$normal_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in normal hash');
+$normal_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in normal hash');
+ok($destroyed[$ID-1], 'Replaced array object in normal hash');
+%normal_hash = ();
+ok($destroyed[$ID], 'Array object removed from cleared normal hash');
+
+$normal_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in normal hash');
+undef(%normal_hash);
+ok($destroyed[$ID], 'Array object removed from undef normal hash');
+
+# Testing with scalar object
+$normal_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal hash');
+delete($normal_hash{'obj'});
+ok($destroyed[$ID], 'Deleted scalar object in normal hash');
+
+$normal_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal hash');
+$normal_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef scalar object in normal hash');
+
+$normal_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal hash');
+$normal_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal hash');
+ok($destroyed[$ID-1], 'Replaced scalar object in normal hash');
+%normal_hash = ();
+ok($destroyed[$ID], 'Scalar object removed from cleared normal hash');
+
+$normal_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in normal hash');
+undef(%normal_hash);
+ok($destroyed[$ID], 'Scalar object removed from undef normal hash');
+
+# Testing with shared array
+my @shared_ary :shared;
+
+my $TODO = ' # TODO perl #98204';
+
+# Testing with hash object
+$shared_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in shared array');
+delete($shared_ary[0]);
+ok($destroyed[$ID], 'Deleted hash object in shared array');
+
+$shared_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in shared array');
+$shared_ary[0] = undef;
+ok($destroyed[$ID], 'Undef hash object in shared array' . $TODO);
+
+$shared_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in shared array');
+$shared_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in shared array');
+ok($destroyed[$ID-1], 'Replaced hash object in shared array' . $TODO);
+@shared_ary = ();
+ok($destroyed[$ID], 'Hash object removed from cleared shared array' . $TODO);
+
+$shared_ary[0] = HashObj->new();
+ok($created[$ID], 'Created hash object in shared array');
+undef(@shared_ary);
+ok($destroyed[$ID], 'Hash object removed from undef shared array' . $TODO);
+
+# Testing with array object
+$shared_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in shared array');
+delete($shared_ary[0]);
+ok($destroyed[$ID], 'Deleted array object in shared array');
+
+$shared_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in shared array');
+$shared_ary[0] = undef;
+ok($destroyed[$ID], 'Undef array object in shared array' . $TODO);
+
+$shared_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in shared array');
+$shared_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in shared array');
+ok($destroyed[$ID-1], 'Replaced array object in shared array' . $TODO);
+@shared_ary = ();
+ok($destroyed[$ID], 'Array object removed from cleared shared array' . $TODO);
+
+$shared_ary[0] = AryObj->new();
+ok($created[$ID], 'Created array object in shared array');
+undef(@shared_ary);
+ok($destroyed[$ID], 'Array object removed from undef shared array' . $TODO);
+
+# Testing with scalar object
+$shared_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared array');
+delete($shared_ary[0]);
+ok($destroyed[$ID], 'Deleted scalar object in shared array');
+
+$shared_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared array');
+$shared_ary[0] = undef;
+ok($destroyed[$ID], 'Undef scalar object in shared array' . $TODO);
+
+$shared_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared array');
+$shared_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared array');
+ok($destroyed[$ID-1], 'Replaced scalar object in shared array' . $TODO);
+@shared_ary = ();
+ok($destroyed[$ID], 'Scalar object removed from cleared shared array' . $TODO);
+
+$shared_ary[0] = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared array');
+undef(@shared_ary);
+ok($destroyed[$ID], 'Scalar object removed from undef shared array' . $TODO);
+
+# Testing with shared hash
+my %shared_hash :shared;
+
+# Testing with hash object
+$shared_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in shared hash');
+delete($shared_hash{'obj'});
+ok($destroyed[$ID], 'Deleted hash object in shared hash');
+
+$shared_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in shared hash');
+$shared_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef hash object in shared hash' . $TODO);
+
+$shared_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in shared hash');
+$shared_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in shared hash');
+ok($destroyed[$ID-1], 'Replaced hash object in shared hash' . $TODO);
+%shared_hash = ();
+ok($destroyed[$ID], 'Hash object removed from cleared shared hash' . $TODO);
+
+$shared_hash{'obj'} = HashObj->new();
+ok($created[$ID], 'Created hash object in shared hash');
+undef(%shared_hash);
+ok($destroyed[$ID], 'Hash object removed from undef shared hash' . $TODO);
+
+# Testing with array object
+$shared_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in shared hash');
+delete($shared_hash{'obj'});
+ok($destroyed[$ID], 'Deleted array object in shared hash');
+
+$shared_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in shared hash');
+$shared_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef array object in shared hash' . $TODO);
+
+$shared_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in shared hash');
+$shared_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in shared hash');
+ok($destroyed[$ID-1], 'Replaced array object in shared hash' . $TODO);
+%shared_hash = ();
+ok($destroyed[$ID], 'Array object removed from cleared shared hash' . $TODO);
+
+$shared_hash{'obj'} = AryObj->new();
+ok($created[$ID], 'Created array object in shared hash');
+undef(%shared_hash);
+ok($destroyed[$ID], 'Array object removed from undef shared hash' . $TODO);
+
+# Testing with scalar object
+$shared_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared hash');
+delete($shared_hash{'obj'});
+ok($destroyed[$ID], 'Deleted scalar object in shared hash');
+
+$shared_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared hash');
+$shared_hash{'obj'} = undef;
+ok($destroyed[$ID], 'Undef scalar object in shared hash' . $TODO);
+
+$shared_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared hash');
+$shared_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared hash');
+ok($destroyed[$ID-1], 'Replaced scalar object in shared hash' . $TODO);
+%shared_hash = ();
+ok($destroyed[$ID], 'Scalar object removed from cleared shared hash' . $TODO);
+
+$shared_hash{'obj'} = SclrObj->new();
+ok($created[$ID], 'Created scalar object in shared hash');
+undef(%shared_hash);
+ok($destroyed[$ID], 'Scalar object removed from undef shared hash' . $TODO);
+
+# EOF