File: perlattrs.t

package info (click to toggle)
libclass-std-perl 0.011-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 352 kB
  • ctags: 122
  • sloc: perl: 871; makefile: 2
file content (31 lines) | stat: -rw-r--r-- 628 bytes parent folder | download | duplicates (4)
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
package MyBase;
use Test::More 'no_plan';

sub MODIFY_HASH_ATTRIBUTES {
    my ($package, $referent, @attrs) = @_;
    for my $attr (@attrs) {
        if ($attr =~ /Loud/) {
            $referent->{Loud} = 1;
        }
        undef $attr
    }
    return grep {defined} @attrs;
}

use Class::Std;
{
    my %name_of :ATTR( :name<name> ) :Loud;

    sub verify {
        my ($self) = @_;
        is $name_of{ident $self}, "mha_test"    => ':ATTR handled correctly';
        is $name_of{Loud}, 1                    => ':Loud handled correctly';
    }
}

package main;

my $obj = MyBase->new({name=>'mha_test'});

$obj->verify();