1use strict;
2use warnings;
3use Test::More;
4use Config;
5
6{
7    my $p = Impostor->new( 'Donald Duck');
8    is( $p->greeting, "Hi, I'm Donald Duck", "blank title");
9    $p->assume_title( 'Mr');
10    is( $p->greeting, "Hi, I'm Mr Donald Duck", "changed title");
11}
12
13# thread support?
14subtest 'threads' => sub {
15    plan skip_all => "No thread support" unless $Config{usethreads};
16
17    require threads;
18    treads->import if threads->can( 'import');
19
20    my $ans;
21    my $p = Impostor->new( 'Donald Duck');
22    $ans = threads->create( sub { $p->greeting })->join;
23    is( $ans, "Hi, I'm Donald Duck", "thread: blank title");
24    $p->assume_title( 'Mr');
25    $ans = threads->create( sub { $p->greeting })->join;
26    is( $ans, "Hi, I'm Mr Donald Duck", "thread: changed title");
27    $ans = threads->create(
28        sub {
29            $p->assume_title( 'Uncle');
30            $p->greeting;
31        }
32    )->join;
33    is( $ans, "Hi, I'm Uncle Donald Duck", "thread: local change");
34    is( $p->greeting, "Hi, I'm Mr Donald Duck", "thread: change is local");
35
36    # second generation thread
37    $ans = threads->create(
38        sub {
39            threads->create( sub { $p->greeting })->join;
40        }
41    )->join;
42    is( $ans, "Hi, I'm Mr Donald Duck", "double thread: got greeting");
43};
44
45
46############################################################################
47
48# must do this in BEGIN so that field hashes are declared before
49# first use above
50
51BEGIN {
52    package CFF;
53    use Hash::Util::FieldHash qw( :all);
54
55    package Person;
56
57    {
58        CFF::fieldhash my %name;
59        CFF::fieldhash my %title;
60
61        sub init {
62            my $p = shift;
63            $name{ $p} = shift || '';
64            $title{ $p} = shift || '';
65            $p;
66        }
67
68        sub name { $name{ shift()} }
69        sub title { $title{ shift() } }
70    }
71
72    sub new {
73        my $class = shift;
74        bless( \ my $x, $class)->init( @_);
75    }
76
77    sub greeting {
78        my $p = shift;
79        my $greet = "Hi, I'm ";
80        $_ and $greet .= "$_ " for $p->title;
81        $greet .= $p->name;
82        $greet;
83    }
84
85    package Impostor;
86    use parent '-norequire', 'Person';
87
88    {
89        CFF::fieldhash my %assumed_title;
90
91        sub init {
92            my $p = shift;
93            my ( $name, $title) = @_;
94            $p->Person::init( $name, $title);
95            $p->assume_title( $title);
96            $p;
97        }
98
99        sub title { $assumed_title{ shift()} }
100
101        sub assume_title {
102            my $p = shift;
103            $assumed_title{ $p} = shift || '';
104            $p;
105        }
106    }
107}
108
109done_testing;
110