File: 02_getopt.t

package info (click to toggle)
libmousex-types-path-class-perl 0.07-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 200 kB
  • sloc: perl: 1,732; makefile: 2
file content (71 lines) | stat: -rw-r--r-- 1,521 bytes parent folder | download | duplicates (3)
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
use Test::More;
use Path::Class qw(dir file);

eval { require MouseX::Getopt };
if ($@) {
    plan skip_all => 'MouseX::Getopt required for this test';
}

do {
    package Foo;
    use Mouse;
    use MouseX::Types::Path::Class;

    with 'MouseX::Getopt';

    has 'dir' => (
        is       => 'ro',
        isa      => 'Path::Class::Dir',
        required => 1,
        coerce   => 1,
    );

    has 'file' => (
        is       => 'ro',
        isa      => 'Path::Class::File',
        required => 1,
        coerce   => 1,
    );

    package Bar;
    use Mouse;
    use MouseX::Types::Path::Class qw(Dir File);

    with 'MouseX::Getopt';

    has 'dir' => (
        is       => 'ro',
        isa      => Dir,
        required => 1,
        coerce   => 1,
    );

    has 'file' => (
        is       => 'ro',
        isa      => File,
        required => 1,
        coerce   => 1,
    );
};

my $dir  = dir('', 'tmp');
my $file = file('', 'tmp', 'foo');

for my $class (qw(Foo Bar)) {
    my $obj = $class->new( dir => "$dir", file => [ '', 'tmp', 'foo' ] );
    isa_ok $obj => $class;
    isa_ok $obj->dir  => 'Path::Class::Dir';
    isa_ok $obj->file => 'Path::Class::File';
    is $obj->dir  => $dir;
    is $obj->file => $file;

    local @ARGV = qw(--dir /tmp --file /tmp/foo);
    my $opt = $class->new_with_options;
    isa_ok $opt => $class;
    isa_ok $opt->dir  => 'Path::Class::Dir';
    isa_ok $opt->file => 'Path::Class::File';
    is $opt->dir  => $dir;
    is $opt->file => $file;
}

done_testing;