« back to all changes in this revision
Viewing changes to t/errors.t
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Krzysztof Krzyzaniak (eloy)
- Date: 2006-01-03 17:29:20 UTC
- Revision ID: james.westby@ubuntu.com-20060103172920-h94p8qrrav90bzq0
Tags: upstream-0.52
Import upstream version 0.52
- files added:
- lib
- lib/Class
- lib/Class/Meta
- lib/Class/Meta/AccessorBuilder
- lib/Class/Meta/Types
- t
added
removed
t/errors.t
1
#!perl -w
2
3
# $Id: errors.t 1379 2005-03-09 18:27:05Z theory $
4
5
##############################################################################
6
# Set up the tests.
7
##############################################################################
8
use strict;
9
use Test::More $] < 5.008
10
? (skip_all => 'Older Carp lacks @CARP_NOT support')
11
: (tests => 208);
12
use File::Spec;
13
my $fn = File::Spec->catfile('t', 'errors.t');
14
15
BEGIN {
16
main::use_ok('Class::Meta');
17
main::use_ok('Class::Meta::Types::String');
18
}
19
20
##############################################################################
21
# Packages we'll use for testing type errors.
22
package NoAttrBuild;
23
sub foo {}
24
$INC{'NoAttrBuild.pm'} = __FILE__;
25
26
package NoAttrGet;
27
sub build {}
28
$INC{'NoAttrGet.pm'} = __FILE__;
29
30
package NoAttrSet;
31
sub build {}
32
sub build_attr_get {}
33
$INC{'NoAttrSet.pm'} = __FILE__;
34
35
##############################################################################
36
# Create some simple classes.
37
##############################################################################
38
39
package Class::Meta::Testing;
40
41
BEGIN {
42
my $cm = Class::Meta->new;
43
$cm->add_constructor( name => 'new' );
44
$cm->add_attribute( name => 'tail', type => 'string' );
45
$cm->build;
46
}
47
48
package Class::Meta::TestAbstract;
49
@Class::Meta::TestAbstract::ISA = qw(Class::Meta::Testing);
50
51
BEGIN {
52
my $cm = Class::Meta->new(abstract => 1);
53
$cm->build;
54
}
55
56
package main;
57
58
##############################################################################
59
# Test Class::Meta errors.
60
eval { Class::Meta->new('foobar') };
61
chk('odd number to Class::Meta->new',
62
qr/Odd number of parameters in call to new()/);
63
64
my $cm = Class::Meta->new( package => 'foobar' );
65
eval { Class::Meta->new( package => 'foobar' ) };
66
67
##############################################################################
68
# Test Class::Meta::Attribute errors.
69
eval { Class::Meta::Attribute->new };
70
chk('Attribute->new protected',
71
qr/ cannot create Class::Meta::Attribute objects/);
72
73
eval { $cm->add_attribute('foo') };
74
chk('odd number to Class::Meta::Attribute->new',
75
qr/Odd number of parameters in call to new()/);
76
77
eval { $cm->add_attribute(desc => 'foo') };
78
chk('Attribute name required',
79
qr/Parameter 'name' is required in call to new()/);
80
81
eval { $cm->add_attribute(name => 'fo&o') };
82
chk('Invalid attribute name',
83
qr/Attribute 'fo&o' is not a valid attribute name/);
84
85
# Create an attribute to use for a few tests. It's private so that there are
86
# no accessors.
87
ok( my $attr = $cm->add_attribute( name => 'foo',
88
type => 'string',
89
view => Class::Meta::PRIVATE),
90
"Create 'foo' attribute");
91
92
eval { $cm->add_attribute( name => 'foo') };
93
chk('Attribute exists', qr/Attribute 'foo' already exists/);
94
95
for my $p (qw(view authz create context)) {
96
eval { $cm->add_attribute( name => 'hey', $p => 100) };
97
chk("Invalid Attribute $p", qr/Not a valid $p parameter: '100'/);
98
}
99
100
eval { $attr->get };
101
chk('No attribute get method', qr/Cannot get attribute 'foo'/);
102
103
eval { $attr->set };
104
chk('No attribute set method', qr/Cannot set attribute 'foo'/);
105
106
eval { $attr->build };
107
chk('Attribute->build protected',
108
qr/ cannot call Class::Meta::Attribute->build/);
109
110
##############################################################################
111
# Test Class::Meta::Class errors.
112
eval { Class::Meta::Class->new };
113
chk('Class->new protected',
114
qr/ cannot create Class::Meta::Class objects/);
115
116
eval { Class::Meta->new( package => 'foobar' ) };
117
chk('Duplicate class', qr/Class object for class 'foobar' already exists/);
118
119
eval { $cm->class->build };
120
chk('Class->build protected',
121
qr/ cannot call Class::Meta::Class->build/);
122
123
##############################################################################
124
# Test Class::Meta::Constructor errors.
125
my $ctor = $cm->class->constructors('new');
126
eval { Class::Meta::Constructor->new };
127
chk('Constructor->new protected',
128
qr/ cannot create Class::Meta::Constructor objects/);
129
130
eval { $cm->add_constructor('foo') };
131
chk('odd number to Class::Meta::Constructor->new',
132
qr/Odd number of parameters in call to new()/);
133
134
eval { $cm->add_constructor(desc => 'foo') };
135
chk('Constructor name required',
136
qr/Parameter 'name' is required in call to new()/);
137
138
eval { $cm->add_constructor(name => 'fo&o') };
139
chk('Invalid constructor name',
140
qr/Constructor 'fo&o' is not a valid constructor name/);
141
142
# Create an constructor to use for a few tests. It's private so that it
143
# can't be called from here.
144
ok( $ctor = $cm->add_constructor( name => 'newer',
145
view => Class::Meta::PRIVATE),
146
"Create 'newer' constructor");
147
148
eval { $cm->add_constructor( name => 'newer') };
149
chk('Constructor exists', qr/Method 'newer' already exists/);
150
151
eval { $cm->add_constructor( name => 'hey', view => 100) };
152
chk("Invalid Constructor view", qr/Not a valid view parameter: '100'/);
153
154
eval { $cm->add_constructor( name => 'hey', caller => 100) };
155
chk("Invalid Constructor caller",
156
qr/Parameter caller must be a code reference/);
157
158
eval { $ctor->call };
159
chk('Cannot call constructor', qr/Cannot call constructor 'newer'/);
160
161
eval { $ctor->build };
162
chk('Constructor->build protected',
163
qr/ cannot call Class::Meta::Constructor->build/);
164
165
# Make sure that the actual constructor's own errors are thrown.
166
eval { Class::Meta::Testing->new( foo => 1 ) };
167
chk('Invalid parameter to generated constructor',
168
qr/No such attribute 'foo' in Class::Meta::Testing objects/);
169
170
##############################################################################
171
# Test Class::Meta::Method errors.
172
eval { Class::Meta::Method->new };
173
chk('Method->new protected',
174
qr/ cannot create Class::Meta::Method objects/);
175
176
eval { $cm->add_method('foo') };
177
chk('odd number to Class::Meta::Method->new',
178
qr/Odd number of parameters in call to new()/);
179
180
eval { $cm->add_method(desc => 'foo') };
181
chk('Method name required',
182
qr/Parameter 'name' is required in call to new()/);
183
184
eval { $cm->add_method(name => 'fo&o') };
185
chk('Invalid method name',
186
qr/Method 'fo&o' is not a valid method name/);
187
188
# Create an method to use for a few tests. It's private so that it
189
# can't be called from here.
190
ok( my $meth = $cm->add_method( name => 'hail',
191
view => Class::Meta::PRIVATE),
192
"Create 'hail' method");
193
194
eval { $cm->add_method( name => 'hail') };
195
chk('Method exists', qr/Method 'hail' already exists/);
196
197
for my $p (qw(view context)) {
198
eval { $cm->add_method( name => 'hey', $p => 100) };
199
chk("Invalid Method $p", qr/Not a valid $p parameter: '100'/);
200
}
201
202
eval { $cm->add_method( name => 'hey', caller => 100) };
203
chk("Invalid Method caller", qr/Parameter caller must be a code reference/);
204
205
eval { $meth->call };
206
chk('Cannot call method', qr/Cannot call method 'hail'/);
207
208
##############################################################################
209
# Test Class::Meta::Type errors.
210
eval { Class::Meta::Type->new };
211
chk(' Missing type', qr/Type argument required/);
212
213
eval { Class::Meta::Type->new('foo') };
214
chk('Invalid type', qr/Type 'foo' does not exist/);
215
216
eval { Class::Meta::Type->add };
217
chk('Type key required', qr/Parameter 'key' is required/);
218
219
eval { Class::Meta::Type->add( key => 'foo') };
220
chk('Type name required', qr/Parameter 'name' is required/);
221
222
eval { Class::Meta::Type->add( key => 'string', name => 'string' ) };
223
chk('Type already exists', qr/Type 'string' already defined/);
224
225
eval { Class::Meta::Type->add( key => 'foo', name => 'foo', check => {}) };
226
chk('Invalid type check',
227
qr/Paremter 'check' in call to add\(\) must be a code reference/);
228
229
eval { Class::Meta::Type->add( key => 'foo', name => 'foo', check => [{}]) };
230
chk('Invalid type check array',
231
qr/Paremter 'check' in call to add\(\) must be a code reference/);
232
233
eval {
234
Class::Meta::Type->add( key => 'foo',
235
name => 'foo',
236
builder => 'NoAttrBuild');
237
};
238
chk('No build', qr/No such function 'NoAttrBuild::build\(\)'/);
239
240
eval {
241
Class::Meta::Type->add( key => 'foo',
242
name => 'foo',
243
builder => 'NoAttrGet');
244
};
245
chk('No attr get', qr/No such function 'NoAttrGet::build_attr_get\(\)'/);
246
247
eval {
248
Class::Meta::Type->add( key => 'foo',
249
name => 'foo',
250
builder => 'NoAttrSet');
251
};
252
chk('No attr set', qr/No such function 'NoAttrSet::build_attr_set\(\)'/);
253
254
eval { Class::Meta::Type->build };
255
chk('Type->build protected', qr/ cannot call Class::Meta::Type->build/);
256
257
eval { Class::Meta->default_error_handler('') };
258
chk('Bad error handler', qr/Error handler must be a code reference/);
259
260
# Make sure we get an error for invalid class error handlers.
261
eval { Class::Meta->new(error_handler => '') };
262
chk('Class cannot have invalid error handler',
263
qr/Error handler must be a code reference/);
264
265
my $foo;
266
Class::Meta->default_error_handler(sub { $foo = shift });
267
268
# Some places still use the default, of course.
269
eval {
270
Class::Meta::Type->add( key => 'foo',
271
name => 'foo',
272
builder => 'NoAttrSet');
273
};
274
like( $foo, qr/No such function 'NoAttrSet::build_attr_set\(\)'/,
275
"New error handler");
276
277
# Others muse use the original, since the class object was defined before
278
# we set up the new default.
279
eval { $cm->class->build };
280
chk('Class->build still protected',
281
qr/ cannot call Class::Meta::Class->build/);
282
283
# Test the abstract attribute.
284
is( Class::Meta::Testing->my_class->abstract, 0,
285
"Testing class isn't abstract" );
286
is( Class::Meta::TestAbstract->my_class->abstract, 1,
287
"TestAbstract class isn't abstract" );
288
289
eval { Class::Meta::TestAbstract->new };
290
chk( 'Cannot create from abstract class',
291
qr/^Cannot construct objects of astract class Class::Meta::TestAbstract/);
292
293
##############################################################################
294
# This function handles all the tests.
295
##############################################################################
296
sub chk {
297
my ($name, $qr) = @_;
298
# Catch the exception.
299
ok( my $err = $@, "Caught $name error" );
300
# Check its message.
301
like( $err, $qr, "Correct error" );
302
# Make sure it refers to this file.
303
like( $err, qr/(?:at\s+\Q$fn\E|\Q$fn\E\s+at)\s+line/, 'Correct context' );
304
# Make sure it doesn't refer to other Class::Meta files.
305
unlike( $err, qr|lib/Class/Meta|, 'Not incorrect context')
306
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1