Skip Menu |

This queue is for tickets about the threads-shared CPAN distribution.

Report information
The Basics
Id: 43332
Status: open
Priority: 0/
Queue: threads-shared

People
Owner: Nobody in particular
Requestors: k.LabMouse [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in:
  • 1.27
  • 1.41
Fixed in: (no value)



Subject: Overloading won't work on somplex structures
Overloading operators won't work on shared structures that are more then 1 level deep. Example/TestCase Attached.
Subject: Set.pm
package Set; use strict; # MultiThreading Support use threads; use threads::shared; use overload ( q/@{}/ => sub { $_[0]->getArray() }, # Overload @{} 'fallback' => 1); sub new { my $class = shift; my $self = { # The items themselves. items => [], }; $self = bless $self, $class; foreach my $item (@_) { $self->add($item); } return $self; } sub add { my ($self, $item) = @_; # MultiThreading Support lock ($self) if (is_shared($self)); lock ($item) if (is_shared($item)); $item = shared_clone($item) if ((is_shared($self)) && (!is_shared($item))); push @{$self->{items}}, $item; } sub clear { my ($self) = @_; # MultiThreading Support if (is_shared($self)) { lock ($self); $self->{items} = &share([]); } else { $self->{items} = []; }; } sub get { my ($self, $index) = @_; # MultiThreading Support lock ($self) if (is_shared($self)); return $self->{items}[$index]; } sub size { my ($self) = @_; # MultiThreading Support lock ($self) if (is_shared($self)); return scalar(@{$self->{items}}); } sub getArray { my ($self) = @_; # MultiThreading Support lock ($self) if (is_shared($self)); return $self->{items}; } 1;
Subject: test.pl
#!/usr/bin/env perl package main; use strict; use threads; use threads::shared; use Set; sub new { my ($class) = @_; my %self = ( something => new Set() ); return bless \%self, $class; } ###################################### # Test 1 print "\nTesting sample 1 (simple)\n"; my $test1 = new Set(); $test1->add("hello1"); $test1->add("hello2"); $test1->add("hello3"); $test1 = shared_clone($test1); # Dump($test1); foreach my $item (@{$test1}) { print $item . "\n"; }; print "Looks good!\n"; # Test 1 End. ###################################### ###################################### # Test 2 print "\nTesting sample 2 (nested structure)\n"; my $test2 = new main(); $test2->{something}->add("hello1"); $test2->{something}->add("hello2"); $test2->{something}->add("hello3"); $test2 = shared_clone($test2); my $something = $test2->{something}; foreach my $item (@{$something}) { print $item . "\n"; }; # Test 2 End. ######################################