Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use FindBin; |
5 | use File::Spec::Functions; |
6 | |
7 | use Test::More; |
8 | use Test::Fatal; |
9 | |
10 | use Class::MOP; |
11 | |
12 | use lib catdir($FindBin::Bin, 'lib'); |
13 | |
14 | isnt( exception { |
15 | Class::MOP::is_class_loaded() |
16 | }, undef, "is_class_loaded with no argument dies" ); |
17 | |
18 | ok(!Class::MOP::is_class_loaded(''), "can't load the empty class"); |
19 | ok(!Class::MOP::is_class_loaded(\"foo"), "can't load a class name reference??"); |
20 | |
21 | ok(!Class::MOP::_is_valid_class_name(undef), 'undef is not a valid class name'); |
22 | ok(!Class::MOP::_is_valid_class_name(''), 'empty string is not a valid class name'); |
23 | ok(!Class::MOP::_is_valid_class_name(\"foo"), 'a reference is not a valid class name'); |
24 | ok(!Class::MOP::_is_valid_class_name('bogus name'), q{'bogus name' is not a valid class name}); |
25 | ok(Class::MOP::_is_valid_class_name('Foo'), q{'Foo' is a valid class name}); |
26 | ok(Class::MOP::_is_valid_class_name('Foo::Bar'), q{'Foo::Bar' is a valid class name}); |
27 | ok(Class::MOP::_is_valid_class_name('Foo_::Bar2'), q{'Foo_::Bar2' is a valid class name}); |
28 | like( exception { Class::MOP::load_class('bogus name') }, qr/Invalid class name \(bogus name\)/ ); |
29 | |
30 | like( exception { |
31 | Class::MOP::load_class('__PACKAGE__') |
32 | }, qr/__PACKAGE__\.pm.*\@INC/, 'errors sanely on __PACKAGE__.pm' ); |
33 | |
34 | Class::MOP::load_class('BinaryTree'); |
35 | can_ok('BinaryTree' => 'traverse'); |
36 | |
37 | do { |
38 | package Class; |
39 | sub method {} |
40 | }; |
41 | |
42 | |
43 | { |
44 | local $@; |
45 | eval { Class::MOP::load_class('Class') }; |
46 | ok( ! $@, 'load_class does not die if the package is already defined' ); |
47 | } |
48 | |
49 | ok( !Class::MOP::does_metaclass_exist("Class"), "no metaclass for non MOP class" ); |
50 | |
51 | like( exception { |
52 | Class::MOP::load_class('FakeClassOhNo'); |
53 | }, qr/Can't locate / ); |
54 | |
55 | like( exception { |
56 | Class::MOP::load_class('SyntaxError'); |
57 | }, qr/Missing right curly/ ); |
58 | |
59 | like( exception { |
60 | delete $INC{'SyntaxError.pm'}; |
61 | Class::MOP::load_first_existing_class( |
62 | 'FakeClassOhNo', 'SyntaxError', 'Class' |
63 | ); |
64 | }, qr/Missing right curly/, 'load_first_existing_class does not pass over an existing (bad) module' ); |
65 | |
66 | like( exception { |
67 | Class::MOP::load_class('This::Does::Not::Exist'); |
68 | }, qr{Can't locate This/Does/Not/Exist\.pm in \@INC}, 'load_first_existing_class throws a familiar error for a single module' ); |
69 | |
70 | { |
71 | package Other; |
72 | use constant foo => "bar"; |
73 | } |
74 | |
75 | is( exception { |
76 | ok(Class::MOP::is_class_loaded("Other"), 'is_class_loaded(Other)'); |
77 | }, undef, "a class with just constants is still a class" ); |
78 | |
79 | { |
80 | package Lala; |
81 | use metaclass; |
82 | } |
83 | |
84 | is( exception { |
85 | is(Class::MOP::load_first_existing_class("Lala", "Does::Not::Exist"), "Lala", 'load_first_existing_class 1/2 params ok, class name returned'); |
86 | is(Class::MOP::load_first_existing_class("Does::Not::Exist", "Lala"), "Lala", 'load_first_existing_class 2/2 params ok, class name returned'); |
87 | }, undef, 'load_classes works' ); |
88 | |
89 | like( exception { |
90 | Class::MOP::load_first_existing_class("Does::Not::Exist", "Also::Does::Not::Exist") |
91 | }, qr/Does::Not::Exist.*Also::Does::Not::Exist/s, 'Multiple non-existant classes cause exception' ); |
92 | |
93 | { |
94 | sub whatever { |
95 | TestClassLoaded::this_method_does_not_even_exist(); |
96 | } |
97 | |
98 | ok( ! Class::MOP::is_class_loaded('TestClassLoaded'), |
99 | 'the mere mention of TestClassLoaded in the whatever sub does not make us think it has been loaded' ); |
100 | } |
101 | |
102 | { |
103 | require TestClassLoaded::Sub; |
104 | ok( ! Class::MOP::is_class_loaded('TestClassLoaded'), |
105 | 'requiring TestClassLoaded::Sub does not make us think TestClassLoaded is loaded' ); |
106 | } |
107 | |
108 | { |
109 | require TestClassLoaded; |
110 | ok( Class::MOP::is_class_loaded('TestClassLoaded'), |
111 | 'We see that TestClassLoaded is loaded after requiring it (it has methods but no $VERSION or @ISA)' ); |
112 | } |
113 | |
114 | { |
115 | require TestClassLoaded2; |
116 | ok( Class::MOP::is_class_loaded('TestClassLoaded2'), |
117 | 'We see that TestClassLoaded2 is loaded after requiring it (it has a $VERSION but no methods or @ISA)' ); |
118 | } |
119 | |
120 | { |
121 | require TestClassLoaded3; |
122 | ok( Class::MOP::is_class_loaded('TestClassLoaded3'), |
123 | 'We see that TestClassLoaded3 is loaded after requiring it (it has an @ISA but no methods or $VERSION)' ); |
124 | } |
125 | |
126 | { |
127 | { |
128 | package Not::Loaded; |
129 | our @ISA; |
130 | } |
131 | |
132 | ok( ! Class::MOP::is_class_loaded('Not::Loaded'), |
133 | 'the mere existence of an @ISA for a package does not mean a class is loaded' ); |
134 | } |
135 | |
136 | { |
137 | { |
138 | package Loaded::Ish; |
139 | our @ISA = 'Foo'; |
140 | } |
141 | |
142 | ok( Class::MOP::is_class_loaded('Loaded::Ish'), |
143 | 'an @ISA with members does mean a class is loaded' ); |
144 | } |
145 | |
146 | { |
147 | { |
148 | package Class::WithVersion; |
149 | our $VERSION = 23; |
150 | }; |
151 | |
152 | ok( Class::MOP::is_class_loaded('Class::WithVersion', { -version => 13 }), |
153 | 'version 23 satisfies version requirement 13' ); |
154 | |
155 | ok( !Class::MOP::is_class_loaded('Class::WithVersion', { -version => 42 }), |
156 | 'version 23 does not satisfy version requirement 42' ); |
157 | |
158 | like( exception { |
159 | Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 42 }); |
160 | }, qr/Class::WithVersion version 42 required--this is only version 23/, 'load_first_existing_class gives correct exception on old version' ); |
161 | |
162 | is( exception { |
163 | Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 13 }); |
164 | }, undef, 'loading class with required version with load_first_existing_class' ); |
165 | |
166 | like( exception { |
167 | Class::MOP::load_class('Class::WithVersion' => { -version => 42 }); |
168 | }, qr/Class::WithVersion version 42 required--this is only version 23/, 'load_class gives correct exception on old version' ); |
169 | |
170 | is( exception { |
171 | Class::MOP::load_class('Class::WithVersion' => { -version => 13 }); |
172 | }, undef, 'loading class with required version with load_class' ); |
173 | |
174 | } |
175 | |
176 | done_testing; |