← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/libclass-meta-perl/intrepid

« back to all changes in this revision

Viewing changes to t/types_semi_affordance.t

  • 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

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/types_semi_affordance.t
 
1
#!/usr/bin/perl -w
 
2
 
 
3
# $Id: types_semi_affordance.t 682 2004-09-28 05:59:10Z theory $
 
4
 
 
5
##############################################################################
 
6
# Set up the tests.
 
7
##############################################################################
 
8
 
 
9
use strict;
 
10
use Test::More tests => 56;
 
11
 
 
12
##############################################################################
 
13
# Create a simple class.
 
14
##############################################################################
 
15
 
 
16
package Class::Meta::TestTypes;
 
17
use strict;
 
18
 
 
19
BEGIN {
 
20
    $SIG{__DIE__} = \&Carp::confess;
 
21
    main::use_ok( 'Class::Meta');
 
22
    main::use_ok( 'Class::Meta::Type');
 
23
    main::use_ok( 'Class::Meta::Types::Numeric', 'semi-affordance');
 
24
    main::use_ok( 'Class::Meta::Types::Perl', 'semi-affordance');
 
25
    main::use_ok( 'Class::Meta::Types::String', 'semi-affordance');
 
26
    main::use_ok( 'Class::Meta::Types::Boolean', 'semi-affordance');
 
27
    @Bart::ISA = qw(Simpson);
 
28
}
 
29
 
 
30
BEGIN {
 
31
    # Add the new data type.
 
32
    Class::Meta::Type->add( key     => 'simpson',
 
33
                            name    => 'Simpson',
 
34
                            desc    => 'An Simpson object.',
 
35
                            check   => 'Simpson',
 
36
                            builder => 'semi-affordance',
 
37
                        );
 
38
 
 
39
    my $c = Class::Meta->new(package => __PACKAGE__,
 
40
                             key     => 'types',
 
41
                             name    => 'Class::Meta::TestTypes Class',
 
42
                             desc    => 'Just for testing Class::Meta.'
 
43
                         );
 
44
    $c->add_constructor(name => 'new');
 
45
 
 
46
    $c->add_attribute( name  => 'name',
 
47
                  view   => Class::Meta::PUBLIC,
 
48
                  type  => 'string',
 
49
                  length   => 256,
 
50
                  label => 'Name',
 
51
                  field => 'text',
 
52
                  desc  => "The person's name.",
 
53
                  required   => 0,
 
54
                  default   => undef,
 
55
                  create   => Class::Meta::GETSET
 
56
              );
 
57
    $c->add_attribute( name  => 'age',
 
58
                  view   => Class::Meta::PUBLIC,
 
59
                  type  => 'integer',
 
60
                  label => 'Age',
 
61
                  field => 'text',
 
62
                  desc  => "The person's age.",
 
63
                  required   => 0,
 
64
                  default   => undef,
 
65
                  create   => Class::Meta::GETSET
 
66
              );
 
67
    $c->add_attribute( name  => 'alive',
 
68
                  view   => Class::Meta::PUBLIC,
 
69
                  type  => 'boolean',
 
70
                  label => 'Living',
 
71
                  field => 'checkbox',
 
72
                  desc  => "Is the person alive?",
 
73
                  required   => 0,
 
74
                  default   => 1,
 
75
              );
 
76
    $c->add_attribute( name  => 'whole',
 
77
                  view   => Class::Meta::PUBLIC,
 
78
                  type  => 'whole',
 
79
                  label => 'A whole number.',
 
80
                  field => 'text',
 
81
                  desc  => "A whole number.",
 
82
                  required   => 0,
 
83
                  default   => undef,
 
84
                  create   => Class::Meta::GETSET
 
85
              );
 
86
    $c->add_attribute( name  => 'dec',
 
87
                  view   => Class::Meta::PUBLIC,
 
88
                  type  => 'decimal',
 
89
                  label => 'A decimal number.',
 
90
                  field => 'text',
 
91
                  desc  => "A decimal number.",
 
92
                  required   => 0,
 
93
                  default   => undef,
 
94
                  create   => Class::Meta::GETSET
 
95
              );
 
96
    $c->add_attribute( name  => 'real',
 
97
                  view   => Class::Meta::PUBLIC,
 
98
                  type  => 'real',
 
99
                  label => 'A real number.',
 
100
                  field => 'text',
 
101
                  desc  => "A real number.",
 
102
                  required   => 0,
 
103
                  default   => undef,
 
104
                  create   => Class::Meta::GETSET
 
105
              );
 
106
    $c->add_attribute( name  => 'float',
 
107
                  view   => Class::Meta::PUBLIC,
 
108
                  type  => 'float',
 
109
                  label => 'A float.',
 
110
                  field => 'text',
 
111
                  desc  => "A floating point number.",
 
112
                  required   => 0,
 
113
                  default   => undef,
 
114
                  create   => Class::Meta::GETSET
 
115
              );
 
116
    $c->add_attribute( name  => 'scalar',
 
117
                  view   => Class::Meta::PUBLIC,
 
118
                  type  => 'scalarref',
 
119
                  label => 'A scalar.',
 
120
                  field => 'text',
 
121
                  desc  => "A scalar reference.",
 
122
                  required   => 0,
 
123
                  default   => undef,
 
124
                  create   => Class::Meta::GETSET
 
125
              );
 
126
    $c->add_attribute( name  => 'array',
 
127
                  view   => Class::Meta::PUBLIC,
 
128
                  type  => 'array',
 
129
                  label => 'A array.',
 
130
                  field => 'text',
 
131
                  desc  => "A array reference.",
 
132
                  required   => 0,
 
133
                  default   => undef,
 
134
                  create   => Class::Meta::GETSET
 
135
              );
 
136
    $c->add_attribute( name  => 'hash',
 
137
                  view   => Class::Meta::PUBLIC,
 
138
                  type  => 'hash',
 
139
                  label => 'A hash.',
 
140
                  field => 'text',
 
141
                  desc  => "A hash reference.",
 
142
                  required   => 0,
 
143
                  default   => undef,
 
144
                  create   => Class::Meta::GETSET
 
145
              );
 
146
    $c->add_attribute( name  => 'simpson',
 
147
                  view   => Class::Meta::PUBLIC,
 
148
                  type  => 'simpson',
 
149
                  label => 'A Simpson Object',
 
150
                  field => 'text',
 
151
                  desc  => 'A Simpson object.',
 
152
                  required   => 0,
 
153
                  default => sub { bless {}, 'Simpson' },
 
154
                  create   => Class::Meta::GETSET
 
155
              );
 
156
    $c->build;
 
157
}
 
158
 
 
159
 
 
160
##############################################################################
 
161
# Do the tests.
 
162
##############################################################################
 
163
 
 
164
package main;
 
165
# Instantiate a base class object and test its accessors.
 
166
ok( my $t = Class::Meta::TestTypes->new, 'Class::Meta::TestTypes->new');
 
167
 
 
168
# Grab its metadata object.
 
169
ok( my $class = $t->my_class, "Get the Class::Meta::Class object" );
 
170
 
 
171
# Test the is_a() method.
 
172
ok( $class->is_a('Class::Meta::TestTypes'), 'Class isa TestTypes');
 
173
 
 
174
# Test the key methods.
 
175
is( $class->key, 'types', 'Key is correct');
 
176
 
 
177
# Test the name method.
 
178
is( $class->name, 'Class::Meta::TestTypes Class', "Name is correct");
 
179
 
 
180
# Test the description methods.
 
181
is( $class->desc, 'Just for testing Class::Meta.',
 
182
    "Description is correct");
 
183
 
 
184
# Test string.
 
185
ok( $t->set_name('David'), 'set_name to "David"' );
 
186
is( $t->name, 'David', 'name is "David"' );
 
187
eval { $t->set_name([]) };
 
188
ok( my $err = $@, 'set_name to array ref croaks' );
 
189
like( $err, qr/^Value .* is not a valid string/, 'correct string exception' );
 
190
 
 
191
# Test boolean.
 
192
ok( $t->is_alive, 'is_alive true');
 
193
is( $t->set_alive_off, 0, 'set_alive_off');
 
194
ok( !$t->is_alive, 'is_alive false');
 
195
ok( $t->set_alive_on, 'set_alive_on' );
 
196
ok( $t->is_alive, 'is_alive true again');
 
197
 
 
198
# Test whole number.
 
199
eval { $t->set_whole(0) };
 
200
ok( $err = $@, 'set_whole to 0 croaks' );
 
201
like( $err, qr/^Value '0' is not a valid whole number/,
 
202
     'correct whole number exception' );
 
203
ok( $t->set_whole(1), 'set_whole to 1.');
 
204
 
 
205
# Test integer.
 
206
eval { $t->set_age(0.5) };
 
207
ok( $err = $@, 'set_age to 0.5 croaks');
 
208
like( $err, qr/^Value '0\.5' is not a valid integer/,
 
209
     'correct integer exception' );
 
210
ok( $t->set_age(10), 'set_age to 10.');
 
211
 
 
212
# Test decimal.
 
213
eval { $t->set_dec('+') };
 
214
ok( $err = $@, 'set_dec to "+" croaks');
 
215
like( $err, qr/^Value '\+' is not a valid decimal number/,
 
216
     'correct decimal exception' );
 
217
ok( $t->set_dec(3.14), 'set_dec to 3.14.');
 
218
 
 
219
# Test real.
 
220
eval { $t->set_real('+') };
 
221
ok( $err = $@, 'set_real to "+" croaks');
 
222
like( $err, qr/^Value '\+' is not a valid real number/,
 
223
     'correct real exception' );
 
224
ok( $t->set_real(123.4567), 'set_real to 123.4567.');
 
225
ok( $t->set_real(-123.4567), 'set_real to -123.4567.');
 
226
 
 
227
# Test float.
 
228
eval { $t->set_float('+') };
 
229
ok( $err = $@, 'set_float to "+" croaks');
 
230
like( $err, qr/^Value '\+' is not a valid floating point number/,
 
231
     'correct float exception' );
 
232
ok( $t->set_float(1.23e99), 'set_float to 1.23e99.');
 
233
 
 
234
# Test OBJECT with default specifying object type.
 
235
ok( my $simpson = $t->simpson, 'simpson' );
 
236
isa_ok($simpson, 'Simpson');
 
237
eval { $t->set_simpson('foo') };
 
238
ok( $err = $@, 'set_simpson to "foo" croaks' );
 
239
like( $err, qr/^Value 'foo' is not a valid Simpson/,
 
240
     'correct object exception' );
 
241
 
 
242
# Try a wrong object.
 
243
eval { $t->set_simpson($t) };
 
244
ok( $err = $@, 'set_simpson to \$fh croaks' );
 
245
like( $err, qr/^Value '.*' is not a valid Simpson/,
 
246
     'correct object exception' );
 
247
ok( $t->set_simpson($simpson), 'set_simpson to \$simpson.');
 
248
 
 
249
# Try a subclass.
 
250
my $bart = bless {}, 'Bart';
 
251
ok( $t->set_simpson($bart), "Set simpson to a subclass." );
 
252
isa_ok($t->simpson, 'Bart', "Check subclass" );
 
253
ok( $t->set_simpson($simpson), 'set_simpson to \$simpson.');
 
254
 
 
255
# Test SCALAR.
 
256
eval { $t->set_scalar('foo') };
 
257
ok( $err = $@, 'set_scalar to "foo" croaks' );
 
258
like( $err, qr/^Value 'foo' is not a valid Scalar Reference/,
 
259
     'correct scalar exception' );
 
260
ok( $t->set_scalar(\"foo"), 'set_scalar to \\"foo".');
 
261
 
 
262
# Test ARRAY.
 
263
eval { $t->set_array('foo') };
 
264
ok( $err = $@, 'set_array to "foo" croaks' );
 
265
like( $err, qr/^Value 'foo' is not a valid Array Reference/,
 
266
     'correct array exception' );
 
267
ok( $t->set_array(["foo"]), 'set_array to ["foo"].');
 
268
 
 
269
# Test HASH.
 
270
eval { $t->set_hash('foo') };
 
271
ok( $err = $@, 'set_hash to "foo" croaks' );
 
272
like( $err, qr/^Value 'foo' is not a valid Hash Reference/,
 
273
     'correct hash exception' );
 
274
ok( $t->set_hash({ foo => 1 }), 'set_hash to { foo => 1 }.');