Thanks for fixing the code but I guess you are missing the point. My contention in an earlier message was that this piece of code by BrowserUk is not thread safe:

sub safe_set {
   my $k = shift;
   my $v :shared = shift;

   lock $$h{ $k };
   $h{$k} = \$v;
}
[download]

My reasoning of it was as follows:

TIMESTEP 0:

    Say, $h{$k} points to v1 
    Thread T0: Holding lock on v1
    Thread T1: Waiting on Lock on v1 

TIMESTEP 1:

    T0 changes $h{$k} = \$v2, releases lock on $v1

TIMESTAMP 2: (Thread T2 makes an entrance)

    Thread T2: Acquires Lock on v2, proceeds
    Thread T1: Acquires Lock on v1, proceeds
    <Race-around condition>
[download]

In other words, the problem with the above safe_set implementation is that it creates a new $v so threads could be waiting on different "copies" of $v, thereby causing a race condition.

To test out safe_set implementation, I made the hash %h to have a single key and tried updates using several threads. Notice that I copy and then add one to it. If there is a race condition the value of variable is surely affected. The code did not run at all and failed giving out a MUTEX_LOCK error: So, the real question here is if my testing code (given below) really points to a problem with the safe_set function. The way you have implemented it basically changes the flavor of safe_set, which of course runs.. I hope you are able to see my point here.

#! perl -slw

use strict;
use threads;
use threads::shared;

our %h : shared;

# Setting up just a single row to increase chances 
# a race condition
our $k = 'AAA';
our $val : shared = 0;
our $THREADS = 50;
our $iter = 50;
$h{$k} = \$val;

# Safe_set similar to BrowserUk 
sub safe_set {
  my $v :shared;
  # Critical Section
  {
     lock ${$h{$k}};
     $v = ${$h{$k}} + 1;
     $h{$k} = \$v;
  }
}

# Keep locking to increment $$h{$k}
sub test_safe_set {
  for (my $i = 0; $i < $iter; ++$i) {
     safe_set();
  }
}

my @pool = map{
      threads->create(\&test_safe_set)
    } 1 .. $THREADS;

$_->join for @pool;

warn ${$h{$k}}, "failed\n" if ${$h{$k}} != $THREADS * $iter;
[download]

. I hope you are able to see my point here.

Yes I can. My untested, typed into the browser, attempt to modify the original safe_set() function to demonstrate the idea that there is no advantage to using a mirrored data structure was broken. Sorry.

For real usage it would have to be something more like this:

sub safe_set {
    my( $ref, $k, $v ) = @_;
    die 'Bad first arg' unless ref( $ref ) eq 'HASH';
    
    if( exists $ref->{ $k } 
    and ref( $ref->{ $k } ) eq 'SCALAR'
    and is_shared( $ref->{ $k } )    
    ) {
        lock ${ $ref->{$k} };
        ${ $ref->{$k} } = $v;
    }
    else {
        lock $ref;
        $ref->{ $k } = \my $vs :shared = $v;
    }
}
[download]

Test, fix-up and sweeten to taste.

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

demonstrate the idea that there is no advantage to using a mirrored data structure

Can't agree with you enough! I think your solution is quite elegant... although now we are back to locking the entire hash structure, albeit briefly from time to time...