7 use Test::More tests => 144;
10 use Mouse::Util::TypeConstraints;
14 # This used to try to _really_ check for a valid Unix or Windows
15 # path, but the regex wasn't quite right, and all we care about
16 # for the tests is that it rejects '/'
17 => where { $_ ne '/' };
21 use Mouse::Util::TypeConstraints;
30 my ( $self, $params ) = @_;
31 confess $params->{path} . " does not exist"
32 unless -e $params->{path};
35 # Defining this causes the FIRST call to Baz->new w/o param to fail,
36 # if no call to ANY Mouse::Object->new was done before.
45 use Mouse::Util::TypeConstraints;
54 my ( $self, $params ) = @_;
55 confess $params->{path} . " does not exist"
56 unless -e $params->{path};
59 # Defining this causes the FIRST call to Qee->new w/o param to fail...
60 # if no call to ANY Mouse::Object->new was done before.
69 use Mouse::Util::TypeConstraints;
78 my ( $self, $params ) = @_;
79 confess $params->{path} . " does not exist"
80 unless -e $params->{path};
83 # Having no DEMOLISH, everything works as expected...
86 check_em ( 'Baz' ); # 'Baz plain' will fail, aka NO error
87 check_em ( 'Qee' ); # ok
88 check_em ( 'Foo' ); # ok
90 check_em ( 'Qee' ); # 'Qee plain' will fail, aka NO error
91 check_em ( 'Baz' ); # ok
92 check_em ( 'Foo' ); # ok
94 check_em ( 'Foo' ); # ok
95 check_em ( 'Baz' ); # ok !
96 check_em ( 'Qee' ); # ok
103 # Uncomment to see, that it is really any first call.
104 # Subsequents calls will not fail, aka giving the correct error.
107 my $obj = eval { $pkg->new; };
108 ::like( $@, qr/is required/, "... $pkg plain" );
109 ::is( $obj, undef, "... the object is undef" );
113 my $obj = eval { $pkg->new(); };
114 ::like( $@, qr/is required/, "... $pkg empty" );
115 ::is( $obj, undef, "... the object is undef" );
119 my $obj = eval { $pkg->new ( notanattr => 1 ); };
120 ::like( $@, qr/is required/, "... $pkg undef" );
121 ::is( $obj, undef, "... the object is undef" );
126 my $obj = eval { $pkg->new ( %param ); };
127 ::like( $@, qr/is required/, "... $pkg undef param" );
128 ::is( $obj, undef, "... the object is undef" );
132 my $obj = eval { $pkg->new ( path => '/' ); };
133 ::like( $@, qr/does not pass the type constraint/, "... $pkg root path forbidden" );
134 ::is( $obj, undef, "... the object is undef" );
138 my $obj = eval { $pkg->new ( path => '/this_path/does/not_exist' ); };
139 ::like( $@, qr/does not exist/, "... $pkg non existing path" );
140 ::is( $obj, undef, "... the object is undef" );
144 my $obj = eval { $pkg->new ( path => $FindBin::Bin ); };
145 ::is( $@, '', "... $pkg no error" );
146 ::isa_ok( $obj, $pkg );
147 ::isa_ok( $obj, 'Mouse::Object' );
148 ::is( $obj->path, $FindBin::Bin, "... $pkg got the right value" );