File: class.t

package info (click to toggle)
libclass-meta-perl 0.66-2.1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 660 kB
  • sloc: perl: 5,886; makefile: 2
file content (63 lines) | stat: -rw-r--r-- 1,850 bytes parent folder | download | duplicates (5)
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
#!/usr/bin/perl -w

use strict;
use Test::More tests => 16;
BEGIN { use_ok( 'Class::Meta') }

# Make sure we can't instantiate a class object from here.
my $class;
eval { $class = Class::Meta::Class->new };
ok( my $err = $@, 'Error creating class' );
like($err, qr/^Package 'main' cannot create.*objects/,
     'Check error message' );

# Now try inheritance.
package Class::Meta::FooSub;
use strict;
use base 'Class::Meta';
Test::More->import;

# Set up simple settings.
my $spec = {
    desc          => 'Foo Class description',
    package       => 'FooClass',
    class         => Class::Meta->new->class,
    error_handler => Class::Meta->default_error_handler,
    key           => 'foo',
    trust         => 'Bar',
    default_type  => 'string',
};

# This should be okay.
ok( $class = Class::Meta::Class->new($spec),
          'Subclass can create class objects' );

# Test the simple accessors.
is( $class->name, ucfirst $spec->{key}, 'name' );
is( $class->desc, $spec->{desc}, 'desc' );
is( $class->key, $spec->{key}, 'key' );
is_deeply( scalar $class->trusted, ['Bar'], 'trusted in scalar context' );
is_deeply( [ $class->trusted ], ['Bar'], 'trusted in list context' );
is( $class->default_type, 'string', 'default_type' );

# Now try inheritance for Class.
package Class::Meta::Class::Sub;
use base 'Class::Meta::Class';

# Make sure we can override new and build.
sub new { shift->SUPER::new(@_) }
sub build { shift->SUPER::build(@_) }

sub foo { shift->{foo} }

package main;
ok( my $cm = Class::Meta->new(
    class_class => 'Class::Meta::Class::Sub',
    foo         => 'bar',
), "Create Class" );
ok( $class = $cm->class, "Retrieve class" );
isa_ok($class, 'Class::Meta::Class::Sub');
isa_ok($class, 'Class::Meta::Class');
is( $class->package, __PACKAGE__, "Check an attibute");
is( $class->foo, 'bar', "Check added attribute" );