YATSB (yet another threads::shared bug)

Dave, if you have the time, would you give some thought to
the bug below?  It seems that all the other threads::shared
bugs I had previously found have been fixed, but this one
still persists.

It starts with a shared object that is attached to a shared
scalar.  Inside a thread, the object is first modified, and
then replaced with a new one.  When the thread terminates,
however, the original object seems to still be in place.
Then the bug just goes away.

Here's the code (it's attached as well):

    #!/usr/bin/perl

    use strict;
    use warnings;

    package Foo; {
        use threads;
        use threads::shared;

        my $ID : shared = 1;   # Incremented with each new object

        sub new
        {
            # Anonymous scalar with an internal ID
            my $obj = \do{ my $scalar = $ID++; };
            # Make it shared
            share($obj);
            # Make it an object
            return (bless($obj, 'Foo'));
        }
    }

    package main;

    use threads;
    use threads::shared;

    use Test::More 'no_plan';

    MAIN:
    {
        my $obj : shared;
        $obj = Foo->new();

        # Check the object - this part is okay
        print("       Main: Object ID $$obj\n");
        is($$obj, 1, "Main: Object ID $$obj");
        print("\n");

        # Now play with the shared object inside a thread
        threads->create( sub {
                # Check the object inside the thread - this part is okay
                print("       Thread: Object ID $$obj\n");
                is($$obj, 1, "Thread: Object ID $$obj");
                print("\n");

                # Modify object's 'ID' - this works
                $$obj = 10;
                print("       Thread: Object ID $$obj\n");
                is($$obj, 10, "Thread: Object ID $$obj");
                print("\n");

                # Replace the object with a new one - this works
                $obj = Foo->new();
                print("       Thread: Object ID $$obj\n");
                is($$obj, 2, "Thread: Object ID $$obj");
                print("\n");

            } )->join();

        # Check the object - it should be the new one from the thread,
        #   but it isn't!
        print("BUG!   Main: Object ID $$obj (should be 2)\n");

        # Wait a minute - suddenly the object reverts!
        #   What's going on here?
        is($$obj, 2, "Main: Object ID $$obj");
        print("       Main: Object ID $$obj\n");
    }
    exit(0);

It produces:

           Main: Object ID 1
    ok 1 - Main: Object ID 1

           Thread: Object ID 1
    ok 2 - Thread: Object ID 1

           Thread: Object ID 10
    ok 3 - Thread: Object ID 10

           Thread: Object ID 2
    ok 4 - Thread: Object ID 2

    BUG!   Main: Object ID 10 (should be 2)
    ok 5 - Main: Object ID 2
           Main: Object ID 2
    1..5

As you can see, after the thread ends, $$obj has the value
from the original object.  Then in the is() call, $$obj
becomes the 'correct' value.

I thought maybe Test::More might be a factor, but commenting
out all the is() calls doesn't fix $$obj after the thread exits.
Further, replacing the final is() call with a dummy() no-op
call does the same thing - it reverts $$obj to the correct
value.

Thanks.

• YATSB (yet another threads::shared bug) by Jerry D. Hedden
• Re: YATSB (yet another threads::shared bug) by Jerry D. Hedden