1 files changed, 118 insertions, 0 deletions
diff --git a/ext/Hash-Util-FieldHash/t/03_class.t b/ext/Hash-Util-FieldHash/t/03_class.t
new file mode 100644
index 0000000000..f064fcc054
--- /dev/null
+++ b/ext/Hash-Util-FieldHash/t/03_class.t
@@ -0,0 +1,118 @@
+#!perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+    }
+}
+
+use strict; use warnings;
+use Test::More;
+my $n_tests = 0;
+
+use Config;
+BEGIN { $n_tests += 2 }
+{
+    my $p = Impostor->new( 'Donald Duck');
+    is( $p->greeting, "Hi, I'm Donald Duck", "blank title");
+    $p->assume_title( 'Mr');
+    is( $p->greeting, "Hi, I'm Mr Donald Duck", "changed title");
+}
+
+# thread support?
+BEGIN { $n_tests += 5 }
+SKIP: {
+    skip "No thread support", 5 unless $Config{ usethreads};
+    require threads;
+    treads->import if threads->can( 'import');
+
+    my $ans;
+    my $p = Impostor->new( 'Donald Duck');
+    $ans = threads->create( sub { $p->greeting })->join;
+    is( $ans, "Hi, I'm Donald Duck", "thread: blank title");
+    $p->assume_title( 'Mr');
+    $ans = threads->create( sub { $p->greeting })->join;
+    is( $ans, "Hi, I'm Mr Donald Duck", "thread: changed title");
+    $ans = threads->create(
+        sub {
+            $p->assume_title( 'Uncle');
+            $p->greeting;
+        }
+    )->join;
+    is( $ans, "Hi, I'm Uncle Donald Duck", "thread: local change");
+    is( $p->greeting, "Hi, I'm Mr Donald Duck", "thread: change is local");
+
+    # second generation thread
+    $ans = threads->create(
+        sub {
+            threads->create( sub { $p->greeting })->join;
+        }
+    )->join;
+    is( $ans, "Hi, I'm Mr Donald Duck", "double thread: got greeting");
+}
+
+BEGIN { plan tests => $n_tests }
+
+############################################################################
+
+# must do this in BEGIN so that field hashes are declared before
+# first use above
+
+BEGIN {
+    package CFF;
+    use Hash::Util::FieldHash qw( :all);
+
+    package Person;
+
+    {
+        CFF::fieldhash my %name;
+        CFF::fieldhash my %title;
+
+        sub init {
+            my $p = shift;
+            $name{ $p} = shift || '';
+            $title{ $p} = shift || '';
+            $p;
+        }
+
+        sub name { $name{ shift()} }
+        sub title { $title{ shift() } }
+    }
+
+    sub new {
+        my $class = shift;
+        bless( \ my $x, $class)->init( @_);
+    }
+
+    sub greeting {
+        my $p = shift;
+        my $greet = "Hi, I'm ";
+        $_ and $greet .= "$_ " for $p->title;
+        $greet .= $p->name;
+        $greet;
+    }
+
+    package Impostor;
+    use base 'Person';
+
+    {
+        CFF::fieldhash my %assumed_title;
+
+        sub init {
+            my $p = shift;
+            my ( $name, $title) = @_;
+            $p->Person::init( $name, $title);
+            $p->assume_title( $title);
+            $p;
+        }
+
+        sub title { $assumed_title{ shift()} }
+        
+        sub assume_title {
+            my $p = shift;
+            $assumed_title{ $p} = shift || '';
+            $p;
+        }
+    }
+}