← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/class.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/class.t
 
1
#!/usr/bin/perl -w
 
2
 
 
3
# $Id: class.t 682 2004-09-28 05:59:10Z theory $
 
4
 
 
5
use strict;
 
6
use Test::More tests => 13;
 
7
BEGIN { use_ok( 'Class::Meta') }
 
8
 
 
9
# Make sure we can't instantiate a class object from here.
 
10
my $class;
 
11
eval { $class = Class::Meta::Class->new };
 
12
ok( my $err = $@, 'Error creating class' );
 
13
like($err, qr/^Package 'main' cannot create.*objects/,
 
14
     'Check error message' );
 
15
 
 
16
# Now try inheritance.
 
17
package Class::Meta::FooSub;
 
18
use strict;
 
19
use base 'Class::Meta';
 
20
Test::More->import;
 
21
 
 
22
# Set up simple settings.
 
23
my $spec = { desc  => 'Foo Class description',
 
24
             package => 'FooClass',
 
25
             class => Class::Meta->new->class,
 
26
             error_handler => Class::Meta->default_error_handler,
 
27
             key   => 'foo' };
 
28
 
 
29
# This should be okay.
 
30
ok( $class = Class::Meta::Class->new($spec),
 
31
          'Subclass can create class objects' );
 
32
 
 
33
# Test the simple accessors.
 
34
is( $class->name, $spec->{key}, 'name' );
 
35
is( $class->desc, $spec->{desc}, 'desc' );
 
36
is( $class->key, $spec->{key}, 'key' );
 
37
 
 
38
# Now try inheritance for Class.
 
39
package Class::Meta::Class::Sub;
 
40
use base 'Class::Meta::Class';
 
41
 
 
42
# Make sure we can override new and build.
 
43
sub new { shift->SUPER::new(@_) }
 
44
sub build { shift->SUPER::build(@_) }
 
45
 
 
46
sub foo { shift->{foo} }
 
47
 
 
48
package main;
 
49
ok( my $cm = Class::Meta->new(
 
50
    class_class => 'Class::Meta::Class::Sub',
 
51
    foo         => 'bar',
 
52
), "Create Class" );
 
53
ok( $class = $cm->class, "Retrieve class" );
 
54
isa_ok($class, 'Class::Meta::Class::Sub');
 
55
isa_ok($class, 'Class::Meta::Class');
 
56
is( $class->package, __PACKAGE__, "Check an attibute");
 
57
is( $class->foo, 'bar', "Check added attribute" );
 
58