← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/attr.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/attr.t
 
1
#!/usr/bin/perl
 
2
 
 
3
# $Id: attr.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 => 44;
 
11
 
 
12
##############################################################################
 
13
# Create a simple class.
 
14
##############################################################################
 
15
 
 
16
package Class::Meta::TestPerson;
 
17
use strict;
 
18
 
 
19
# Make sure we can load Class::Meta.
 
20
BEGIN {
 
21
    main::use_ok( 'Class::Meta' );
 
22
    main::use_ok( 'Class::Meta::Types::String' );
 
23
}
 
24
 
 
25
BEGIN {
 
26
    # Import Test::More functions into this package.
 
27
    Test::More->import;
 
28
 
 
29
    # Create a new Class::Meta object.
 
30
    ok( my $c = Class::Meta->new(key => 'person'),
 
31
        "Create CM object" );
 
32
    isa_ok($c, 'Class::Meta');
 
33
 
 
34
    # Create an attribute.
 
35
    sub inst { bless {} }
 
36
    ok( my $attr = $c->add_attribute( name => 'inst',
 
37
                                      type => 'string',
 
38
                                      desc    => 'The inst attribute',
 
39
                                      label   => 'inst Attribute',
 
40
                                      view     => Class::Meta::PUBLIC ),
 
41
        "Create 'inst' attr");
 
42
    isa_ok($attr, 'Class::Meta::Attribute');
 
43
 
 
44
    # Test its accessors.
 
45
    is( $attr->name, "inst", "Check inst name" );
 
46
    is( $attr->desc, "The inst attribute", "Check inst desc" );
 
47
    is( $attr->label, "inst Attribute", "Check inst label" );
 
48
    is( $attr->type, "string", "Check inst type" );
 
49
    ok( $attr->view == Class::Meta::PUBLIC, "Check inst view" );
 
50
 
 
51
    # Okay, now test to make sure that an attempt to create a attribute
 
52
    # directly fails.
 
53
    eval { my $attr = Class::Meta::Attribute->new };
 
54
    ok( my $err = $@, "Get attribute construction exception");
 
55
    like( $err, qr/Package 'Class::Meta::TestPerson' cannot create/,
 
56
        "Caught proper exception");
 
57
 
 
58
    # Now try it without a name.
 
59
    eval{ $c->add_attribute() };
 
60
    ok( $err = $@, "Caught no name exception");
 
61
    like( $err, qr/Parameter 'name' is required in call to new/,
 
62
        "Caught proper no name exception");
 
63
 
 
64
    # Try a duplicately-named attribute.
 
65
    eval{ $c->add_attribute(name => 'inst') };
 
66
    ok( $err = $@, "Caught dupe name exception");
 
67
    like( $err, qr/Attribute 'inst' already exists in class/,
 
68
        "Caught proper dupe name exception");
 
69
 
 
70
    # Try a couple of bogus visibilities.
 
71
    eval { $c->add_attribute( name => 'new_attr',
 
72
                         view  => 25) };
 
73
    ok( $err = $@, "Caught bogus view exception");
 
74
    like( $err, qr/Not a valid view parameter: '25'/,
 
75
        "Caught proper bogus view exception");
 
76
    eval { $c->add_attribute( name => 'new_attr',
 
77
                         view  => 10) };
 
78
    ok( $err = $@, "Caught another bogus view exception");
 
79
    like( $err, qr/Not a valid view parameter: '10'/,
 
80
        "Caught another proper bogus view exception");
 
81
 
 
82
    # Try a bogus caller.
 
83
    eval { $c->add_method( name => 'new_inst',
 
84
                         caller => 'foo' ) };
 
85
    ok( $err = $@, "Caught bogus caller exception");
 
86
    like( $err, qr/Parameter caller must be a code reference/,
 
87
        "Caught proper bogus caller exception");
 
88
 
 
89
    # Now test all of the defaults.
 
90
    sub new_attr { 22 }
 
91
    ok( $attr = $c->add_attribute( name => 'new_attr' ), "Create 'new_attr'" );
 
92
    isa_ok($attr, 'Class::Meta::Attribute');
 
93
 
 
94
    # Test its accessors.
 
95
    is( $attr->name, "new_attr", "Check new_attr name" );
 
96
    ok( ! defined $attr->desc, "Check new_attr desc" );
 
97
    ok( ! defined $attr->label, "Check new_attr label" );
 
98
    ok( $attr->view == Class::Meta::PUBLIC, "Check new_attr view" );
 
99
}
 
100
 
 
101
# Now try subclassing Class::Meta.
 
102
 
 
103
package Class::Meta::SubClass;
 
104
use base 'Class::Meta';
 
105
sub add_attribute {
 
106
    Class::Meta::Attribute->new( shift->SUPER::class, @_);
 
107
}
 
108
 
 
109
package Class::Meta::AnotherTest;
 
110
use strict;
 
111
 
 
112
BEGIN {
 
113
    # Import Test::More functions into this package.
 
114
    Test::More->import;
 
115
 
 
116
    # Create a new Class::Meta object.
 
117
    ok( my $c = Class::Meta::SubClass->new
 
118
        (another => __PACKAGE__), "Create subclassed CM object" );
 
119
    isa_ok($c, 'Class::Meta');
 
120
    isa_ok($c, 'Class::Meta::SubClass');
 
121
 
 
122
    sub foo_attr { bless {} }
 
123
    ok( my $attr = $c->add_attribute( name => 'foo_attr'),
 
124
        'Create subclassed foo_attr' );
 
125
 
 
126
    isa_ok($attr, 'Class::Meta::Attribute');
 
127
 
 
128
    # Test its accessors.
 
129
    is( $attr->name, "foo_attr", "Check new foo_attr name" );
 
130
    ok( ! defined $attr->desc, "Check new foo_attr desc" );
 
131
    ok( ! defined $attr->label, "Check new foo_attr label" );
 
132
    ok( $attr->view == Class::Meta::PUBLIC, "Check new foo_attr view" );
 
133
}
 
134
 
 
135
##############################################################################
 
136
# Now try subclassing Class::Meta::Attribute.
 
137
package Class::Meta::Attribute::Sub;
 
138
use base 'Class::Meta::Attribute';
 
139
 
 
140
# Make sure we can override new and build.
 
141
sub new { shift->SUPER::new(@_) }
 
142
sub build { shift->SUPER::build(@_) }
 
143
 
 
144
sub foo { shift->{foo} }
 
145
 
 
146
package main;
 
147
ok( my $cm = Class::Meta->new(
 
148
    attribute_class => 'Class::Meta::Attribute::Sub',
 
149
), "Create Class" );
 
150
ok( my $attr = $cm->add_attribute(name => 'foo', foo => 'bar'),
 
151
    "Add foo attribute" );
 
152
isa_ok($attr, 'Class::Meta::Attribute::Sub');
 
153
isa_ok($attr, 'Class::Meta::Attribute');
 
154
is( $attr->name, 'foo', "Check an attibute");
 
155
is( $attr->foo, 'bar', "Check added attribute" );
 
156