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