Commit | Line | Data |
47bfa72e |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
5 | use Test::Moose; |
6 | use B; |
7 | |
8 | { |
9 | package Foo; |
10 | use Moose; |
11 | |
12 | has foo => (is => 'ro', default => 100); |
13 | |
14 | sub bar { 100 } |
15 | } |
16 | |
17 | with_immutable { |
18 | my $foo = Foo->new; |
19 | for my $meth (qw(foo bar)) { |
20 | my $val = $foo->$meth; |
21 | my $b = B::svref_2object(\$val); |
22 | my $flags = $b->FLAGS; |
23 | ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); |
24 | ok(!($flags & B::SVf_POK), "not a string"); |
25 | } |
26 | } 'Foo'; |
27 | |
28 | { |
29 | package Bar; |
30 | use Moose; |
31 | |
32 | has foo => (is => 'ro', lazy => 1, default => 100); |
33 | |
34 | sub bar { 100 } |
35 | } |
36 | |
37 | with_immutable { |
38 | my $bar = Bar->new; |
39 | for my $meth (qw(foo bar)) { |
40 | my $val = $bar->$meth; |
41 | my $b = B::svref_2object(\$val); |
42 | my $flags = $b->FLAGS; |
43 | ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); |
44 | ok(!($flags & B::SVf_POK), "not a string"); |
45 | } |
46 | } 'Bar'; |
47 | |
48 | { |
49 | package Baz; |
50 | use Moose; |
51 | |
52 | has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100); |
53 | |
54 | sub bar { 100 } |
55 | } |
56 | |
57 | with_immutable { |
58 | my $baz = Baz->new; |
59 | for my $meth (qw(foo bar)) { |
60 | my $val = $baz->$meth; |
61 | my $b = B::svref_2object(\$val); |
62 | my $flags = $b->FLAGS; |
63 | ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); |
64 | ok(!($flags & B::SVf_POK), "not a string"); |
65 | } |
66 | } 'Baz'; |
67 | |
68 | { |
69 | package Foo2; |
70 | use Moose; |
71 | |
72 | has foo => (is => 'ro', default => 10.5); |
73 | |
74 | sub bar { 10.5 } |
75 | } |
76 | |
77 | with_immutable { |
78 | my $foo2 = Foo2->new; |
79 | for my $meth (qw(foo bar)) { |
80 | my $val = $foo2->$meth; |
81 | my $b = B::svref_2object(\$val); |
82 | my $flags = $b->FLAGS; |
83 | ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); |
84 | ok(!($flags & B::SVf_POK), "not a string"); |
85 | } |
86 | } 'Foo2'; |
87 | |
88 | { |
89 | package Bar2; |
90 | use Moose; |
91 | |
92 | has foo => (is => 'ro', lazy => 1, default => 10.5); |
93 | |
94 | sub bar { 10.5 } |
95 | } |
96 | |
97 | with_immutable { |
98 | my $bar2 = Bar2->new; |
99 | for my $meth (qw(foo bar)) { |
100 | my $val = $bar2->$meth; |
101 | my $b = B::svref_2object(\$val); |
102 | my $flags = $b->FLAGS; |
103 | ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); |
104 | ok(!($flags & B::SVf_POK), "not a string"); |
105 | } |
106 | } 'Bar2'; |
107 | |
108 | { |
109 | package Baz2; |
110 | use Moose; |
111 | |
112 | has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5); |
113 | |
114 | sub bar { 10.5 } |
115 | } |
116 | |
117 | with_immutable { |
118 | my $baz2 = Baz2->new; |
119 | for my $meth (qw(foo bar)) { |
120 | my $val = $baz2->$meth; |
121 | my $b = B::svref_2object(\$val); |
122 | my $flags = $b->FLAGS; |
123 | ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); |
124 | ok(!($flags & B::SVf_POK), "not a string"); |
125 | } |
126 | } 'Baz2'; |
127 | |
128 | done_testing; |