forgot to add new file to change #26350

p4raw-link: @26350 on //depot/perl: 402174ade5cfc00aa74adb59911c447ef485c570

p4raw-id: //depot/perl@26351

diff --git a/ext/threads/shared/t/blessed.t b/ext/threads/shared/t/blessed.t
new file mode 100644 (file)
index 0000000..78e68c1
--- /dev/null
+++ b/ext/threads/shared/t/blessed.t
@@ -0,0 +1,134 @@
+use warnings;
+
+BEGIN {
+#    chdir 't' if -d 't';
+#    push @INC ,'../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+        print "1..0 # Skip: no useithreads\n";
+        exit 0;
+    }
+}
+
+
+sub ok {
+    my ($id, $ok, $name) = @_;
+
+    $name = '' unless defined $name;
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+    return $ok;
+}
+
+sub skip {
+    my ($id, $ok, $name) = @_;
+    print "ok $id # skip _thrcnt - $name \n";
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..36\n" };
+use threads;
+use threads::shared;
+
+my ($hobj, $aobj, $sobj) : shared;
+
+$hobj = &share({});
+$aobj = &share([]);
+my $sref = \do{ my $x };
+share($sref);
+$sobj = $sref;
+
+threads->new(sub {
+                # Bless objects
+                bless $hobj, 'foo';
+                bless $aobj, 'bar';
+                bless $sobj, 'baz';
+
+                # Add data to objects
+                $$aobj[0] = bless(&share({}), 'yin');
+                $$aobj[1] = bless(&share([]), 'yang');
+                $$aobj[2] = $sobj;
+
+                $$hobj{'hash'}   = bless(&share({}), 'yin');
+                $$hobj{'array'}  = bless(&share([]), 'yang');
+                $$hobj{'scalar'} = $sobj;
+
+                $$sobj = 3;
+
+                # Test objects in child thread
+                ok(1, ref($hobj) eq 'foo', "hash blessing does work");
+                ok(2, ref($aobj) eq 'bar', "array blessing does work");
+                ok(3, ref($sobj) eq 'baz', "scalar blessing does work");
+                ok(4, $$sobj eq '3', "scalar contents okay");
+
+                ok(5, ref($$aobj[0]) eq 'yin', "blessed hash in array");
+                ok(6, ref($$aobj[1]) eq 'yang', "blessed array in array");
+                ok(7, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
+                ok(8, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
+
+                ok(9, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
+                ok(10, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
+                ok(11, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
+                ok(12, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
+
+             })->join;
+
+# Test objects in parent thread
+ok(13, ref($hobj) eq 'foo', "hash blessing does work");
+ok(14, ref($aobj) eq 'bar', "array blessing does work");
+ok(15, ref($sobj) eq 'baz', "scalar blessing does work");
+ok(16, $$sobj eq '3', "scalar contents okay");
+
+ok(17, ref($$aobj[0]) eq 'yin', "blessed hash in array");
+ok(18, ref($$aobj[1]) eq 'yang', "blessed array in array");
+ok(19, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
+ok(20, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
+
+ok(21, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
+ok(22, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
+ok(23, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
+ok(24, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
+
+threads->new(sub {
+                # Rebless objects
+                bless $hobj, 'oof';
+                bless $aobj, 'rab';
+                bless $sobj, 'zab';
+
+                my $data = $$aobj[0];
+                bless $data, 'niy';
+                $$aobj[0] = $data;
+                $data = $$aobj[1];
+                bless $data, 'gnay';
+                $$aobj[1] = $data;
+
+                $data = $$hobj{'hash'};
+                bless $data, 'niy';
+                $$hobj{'hash'} = $data;
+                $data = $$hobj{'array'};
+                bless $data, 'gnay';
+                $$hobj{'array'} = $data;
+
+                $$sobj = 'test';
+             })->join;
+
+# Test reblessing
+ok(25, ref($hobj) eq 'oof', "hash reblessing does work");
+ok(26, ref($aobj) eq 'rab', "array reblessing does work");
+ok(27, ref($sobj) eq 'zab', "scalar reblessing does work");
+ok(28, $$sobj eq 'test', "scalar contents okay");
+
+ok(29, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
+ok(30, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
+ok(31, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
+ok(32, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
+
+ok(33, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
+ok(34, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
+ok(35, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
+ok(36, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents");
+