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

« back to all changes in this revision

Viewing changes to t/constraints_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:
 
1
#!perl -w
 
2
 
 
3
# $Id: constraints_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 => 22;
 
11
 
 
12
##############################################################################
 
13
# Create a simple class.
 
14
##############################################################################
 
15
 
 
16
package Class::Meta::Testing123;
 
17
use strict;
 
18
 
 
19
BEGIN {
 
20
    main::use_ok('Class::Meta');
 
21
    main::use_ok('Class::Meta::Types::String', 'affordance');
 
22
}
 
23
 
 
24
BEGIN {
 
25
    # Import Test::More functions into this package.
 
26
    Test::More->import;
 
27
    ok( my $cm = Class::Meta->new, "Create new Class::Meta object" );
 
28
 
 
29
    # Add a constructor.
 
30
    ok( $cm->add_constructor( name => 'new',
 
31
                             create  => 1 ),
 
32
        "Add constructor" );
 
33
 
 
34
    # Add a required attribute with a default
 
35
    ok( $cm->add_attribute( name     => 'req_def',
 
36
                            type     => 'string',
 
37
                            required => 1,
 
38
                            default  => 'hello',
 
39
                       ),
 
40
        "Add required attribute with a default" );
 
41
 
 
42
    # Add a once attribute.
 
43
    ok( $cm->add_attribute( name => 'once',
 
44
                            type => 'string',
 
45
                            once => 1,
 
46
                       ),
 
47
        "Add a once attribute" );
 
48
 
 
49
    # Add a once attribute with a default.
 
50
    ok( $cm->add_attribute( name    => 'once_def',
 
51
                            type    => 'string',
 
52
                            once    => 1,
 
53
                            default => 'hola',
 
54
                       ),
 
55
        "Add a once attribute" );
 
56
 
 
57
    # Add a required once attribute with a default.
 
58
    ok( $cm->add_attribute( name     => 'once_req',
 
59
                            type     => 'string',
 
60
                            once     => 1,
 
61
                            required => 1,
 
62
                            default  => 'bonjour',
 
63
                       ),
 
64
        "Add a required once attribute" );
 
65
 
 
66
    # Build the class.
 
67
    ok( $cm->build, "Build class" );
 
68
}
 
69
 
 
70
package main;
 
71
 
 
72
ok( my $obj = Class::Meta::Testing123->new, 'Create new object' );
 
73
 
 
74
# Check required attribute.
 
75
is( $obj->get_req_def, 'hello', 'Check required attribute' );
 
76
ok( $obj->set_req_def('foo'), 'Set required attribute' );
 
77
is( $obj->get_req_def, 'foo', 'Check required attribute new value' );
 
78
eval { $obj->set_req_def(undef) };
 
79
ok( $@, 'Catch required exception' );
 
80
 
 
81
# Check once attribute.
 
82
is( $obj->get_once, undef, "Once is undefined" );
 
83
ok( $obj->set_once('hee'), "set once attribute" );
 
84
is( $obj->get_once, 'hee', "Check new once value" );
 
85
eval { $obj->set_once('ha') };
 
86
ok( $@, 'Catch once exception' );
 
87
 
 
88
# Check once with a default.
 
89
is( $obj->get_once_def, 'hola', 'Check once_def' );
 
90
eval { $obj->set_once_def('ha') };
 
91
ok( $@, 'Catch once_def exception' );
 
92
 
 
93
# Check required once with a default.
 
94
is( $obj->get_once_req, 'bonjour', 'Check once_req' );
 
95
eval { $obj->set_once_def('ha') };
 
96
ok( $@, 'Catch once_req exception' );