Commit | Line | Data |
38bf2a25 |
1 | # Testing magical scalars (using tied scalar) |
2 | # Note that XSUBs do not handle magical scalars automatically. |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Test::More; |
8 | use Test::Fatal; |
9 | |
10 | use Class::MOP; |
11 | |
12 | use Tie::Scalar; |
13 | |
14 | { |
15 | package Foo; |
16 | use metaclass; |
17 | |
18 | Foo->meta->add_attribute('bar' => |
19 | reader => 'get_bar', |
20 | writer => 'set_bar', |
21 | ); |
22 | |
23 | Foo->meta->add_attribute('baz' => |
24 | accessor => 'baz', |
25 | ); |
26 | |
27 | Foo->meta->make_immutable(); |
28 | } |
29 | |
30 | { |
31 | tie my $foo, 'Tie::StdScalar', Foo->new(bar => 100, baz => 200); |
32 | |
33 | is $foo->get_bar, 100, 'reader with tied self'; |
34 | is $foo->baz, 200, 'accessor/r with tied self'; |
35 | |
36 | $foo->set_bar(300); |
37 | $foo->baz(400); |
38 | |
39 | is $foo->get_bar, 300, 'writer with tied self'; |
40 | is $foo->baz, 400, 'accessor/w with tied self'; |
41 | } |
42 | |
43 | { |
44 | my $foo = Foo->new(); |
45 | |
46 | tie my $value, 'Tie::StdScalar', 42; |
47 | |
48 | $foo->set_bar($value); |
49 | $foo->baz($value); |
50 | |
51 | is $foo->get_bar, 42, 'reader/writer with tied value'; |
52 | is $foo->baz, 42, 'accessor with tied value'; |
53 | } |
54 | |
55 | { |
56 | my $x = tie my $value, 'Tie::StdScalar', 'Class::MOP'; |
57 | |
58 | is( exception { Class::MOP::load_class($value) }, undef, 'load_class(tied scalar)' ); |
59 | |
60 | $value = undef; |
61 | $x->STORE('Class::MOP'); # reset |
62 | |
63 | is( exception { |
64 | ok Class::MOP::is_class_loaded($value); |
65 | }, undef, 'is_class_loaded(tied scalar)' ); |
66 | |
67 | $value = undef; |
68 | $x->STORE(\&Class::MOP::get_code_info); # reset |
69 | |
70 | is( exception { |
71 | is_deeply [Class::MOP::get_code_info($value)], [qw(Class::MOP get_code_info)], 'get_code_info(tied scalar)'; |
72 | }, undef ); |
73 | } |
74 | |
75 | done_testing; |