File: constraints_affordance.t

package info (click to toggle)
libclass-meta-perl 0.53-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 544 kB
  • ctags: 124
  • sloc: perl: 5,571; makefile: 44
file content (96 lines) | stat: -rw-r--r-- 3,127 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#!perl -w

# $Id: constraints_affordance.t 682 2004-09-28 05:59:10Z theory $

##############################################################################
# Set up the tests.
##############################################################################

use strict;
use Test::More tests => 22;

##############################################################################
# Create a simple class.
##############################################################################

package Class::Meta::Testing123;
use strict;

BEGIN {
    main::use_ok('Class::Meta');
    main::use_ok('Class::Meta::Types::String', 'affordance');
}

BEGIN {
    # Import Test::More functions into this package.
    Test::More->import;
    ok( my $cm = Class::Meta->new, "Create new Class::Meta object" );

    # Add a constructor.
    ok( $cm->add_constructor( name => 'new',
                             create  => 1 ),
        "Add constructor" );

    # Add a required attribute with a default
    ok( $cm->add_attribute( name     => 'req_def',
                            type     => 'string',
                            required => 1,
                            default  => 'hello',
                       ),
        "Add required attribute with a default" );

    # Add a once attribute.
    ok( $cm->add_attribute( name => 'once',
                            type => 'string',
                            once => 1,
                       ),
        "Add a once attribute" );

    # Add a once attribute with a default.
    ok( $cm->add_attribute( name    => 'once_def',
                            type    => 'string',
                            once    => 1,
                            default => 'hola',
                       ),
        "Add a once attribute" );

    # Add a required once attribute with a default.
    ok( $cm->add_attribute( name     => 'once_req',
                            type     => 'string',
                            once     => 1,
                            required => 1,
                            default  => 'bonjour',
                       ),
        "Add a required once attribute" );

    # Build the class.
    ok( $cm->build, "Build class" );
}

package main;

ok( my $obj = Class::Meta::Testing123->new, 'Create new object' );

# Check required attribute.
is( $obj->get_req_def, 'hello', 'Check required attribute' );
ok( $obj->set_req_def('foo'), 'Set required attribute' );
is( $obj->get_req_def, 'foo', 'Check required attribute new value' );
eval { $obj->set_req_def(undef) };
ok( $@, 'Catch required exception' );

# Check once attribute.
is( $obj->get_once, undef, "Once is undefined" );
ok( $obj->set_once('hee'), "set once attribute" );
is( $obj->get_once, 'hee', "Check new once value" );
eval { $obj->set_once('ha') };
ok( $@, 'Catch once exception' );

# Check once with a default.
is( $obj->get_once_def, 'hola', 'Check once_def' );
eval { $obj->set_once_def('ha') };
ok( $@, 'Catch once_def exception' );

# Check required once with a default.
is( $obj->get_once_req, 'bonjour', 'Check once_req' );
eval { $obj->set_once_def('ha') };
ok( $@, 'Catch once_req exception' );