Try it this way:

#! 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 {
  # Critical Section
  {
     lock ${$h{$k}};
      ${ $h{$k} } = ${ $h{$k}   } + 1;
  }
}

# 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]

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.

Dunno, but safe_set does a lot of work for nothing. It assumes $h{$k} is already a reference to a shared var, so why does it create a new one?

sub safe_inc {
  lock ${$h{$k}};
  ${$h{$k}} = ${$h{$k}} + 1;
}
[download]