Commit | Line | Data |
38bf2a25 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
5 | use B; |
6 | use Class::MOP; |
7 | |
8 | my @int_defaults = ( |
9 | 100, |
10 | -2, |
11 | 01234, |
12 | 0xFF, |
13 | ); |
14 | |
15 | my @num_defaults = ( |
16 | 10.5, |
17 | -20.0, |
18 | 1e3, |
19 | 1.3e-10, |
20 | ); |
21 | |
22 | my @string_defaults = ( |
23 | 'foo', |
24 | '', |
25 | '100', |
26 | '10.5', |
27 | '1e3', |
28 | '0 but true', |
29 | '01234', |
30 | '09876', |
31 | '0xFF', |
32 | ); |
33 | |
34 | for my $default (@int_defaults) { |
35 | my $copy = $default; # so we can print it out without modifying flags |
36 | my $attr = Class::MOP::Attribute->new( |
37 | foo => (default => $default, reader => 'foo'), |
38 | ); |
39 | my $meta = Class::MOP::Class->create_anon_class( |
40 | attributes => [$attr], |
41 | methods => {bar => sub { $default }}, |
42 | ); |
43 | |
44 | my $obj = $meta->new_object; |
45 | for my $meth (qw(foo bar)) { |
46 | my $val = $obj->$meth; |
47 | my $b = B::svref_2object(\$val); |
48 | my $flags = $b->FLAGS; |
49 | ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int ($copy)"); |
50 | ok(!($flags & B::SVf_POK), "not a string ($copy)"); |
51 | } |
52 | |
53 | $meta->make_immutable; |
54 | |
55 | my $immutable_obj = $meta->name->new; |
56 | for my $meth (qw(foo bar)) { |
57 | my $val = $immutable_obj->$meth; |
58 | my $b = B::svref_2object(\$val); |
59 | my $flags = $b->FLAGS; |
60 | ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int ($copy) (immutable)"); |
61 | ok(!($flags & B::SVf_POK), "not a string ($copy) (immutable)"); |
62 | } |
63 | } |
64 | |
65 | for my $default (@num_defaults) { |
66 | my $copy = $default; # so we can print it out without modifying flags |
67 | my $attr = Class::MOP::Attribute->new( |
68 | foo => (default => $default, reader => 'foo'), |
69 | ); |
70 | my $meta = Class::MOP::Class->create_anon_class( |
71 | attributes => [$attr], |
72 | methods => {bar => sub { $default }}, |
73 | ); |
74 | |
75 | my $obj = $meta->new_object; |
76 | for my $meth (qw(foo bar)) { |
77 | my $val = $obj->$meth; |
78 | my $b = B::svref_2object(\$val); |
79 | my $flags = $b->FLAGS; |
80 | ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num ($copy)"); |
81 | ok(!($flags & B::SVf_POK), "not a string ($copy)"); |
82 | } |
83 | |
84 | $meta->make_immutable; |
85 | |
86 | my $immutable_obj = $meta->name->new; |
87 | for my $meth (qw(foo bar)) { |
88 | my $val = $immutable_obj->$meth; |
89 | my $b = B::svref_2object(\$val); |
90 | my $flags = $b->FLAGS; |
91 | ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num ($copy) (immutable)"); |
92 | ok(!($flags & B::SVf_POK), "not a string ($copy) (immutable)"); |
93 | } |
94 | } |
95 | |
96 | for my $default (@string_defaults) { |
97 | my $copy = $default; # so we can print it out without modifying flags |
98 | my $attr = Class::MOP::Attribute->new( |
99 | foo => (default => $default, reader => 'foo'), |
100 | ); |
101 | my $meta = Class::MOP::Class->create_anon_class( |
102 | attributes => [$attr], |
103 | methods => {bar => sub { $default }}, |
104 | ); |
105 | |
106 | my $obj = $meta->new_object; |
107 | for my $meth (qw(foo bar)) { |
108 | my $val = $obj->$meth; |
109 | my $b = B::svref_2object(\$val); |
110 | my $flags = $b->FLAGS; |
111 | ok($flags & B::SVf_POK, "it's a string ($copy)"); |
112 | } |
113 | |
114 | $meta->make_immutable; |
115 | |
116 | my $immutable_obj = $meta->name->new; |
117 | for my $meth (qw(foo bar)) { |
118 | my $val = $immutable_obj->$meth; |
119 | my $b = B::svref_2object(\$val); |
120 | my $flags = $b->FLAGS; |
121 | ok($flags & B::SVf_POK, "it's a string ($copy) (immutable)"); |
122 | } |
123 | } |
124 | |
125 | done_testing; |