From: gfx Date: Mon, 19 Oct 2009 08:44:11 +0000 (+0900) Subject: Resolve some tests X-Git-Tag: 0.40~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b910be93608c1bd94abc22dbaea7c487b16e9993;p=gitmo%2FMouse.git Resolve some tests --- diff --git a/t/040_type_constraints/failing/005_util_type_coercion.t b/t/040_type_constraints/005_util_type_coercion.t similarity index 98% rename from t/040_type_constraints/failing/005_util_type_coercion.t rename to t/040_type_constraints/005_util_type_coercion.t index 8b5a77a..8755dcf 100644 --- a/t/040_type_constraints/failing/005_util_type_coercion.t +++ b/t/040_type_constraints/005_util_type_coercion.t @@ -6,6 +6,9 @@ use warnings; use Test::More tests => 26; use Test::Exception; +use lib 't/lib'; +use Test::Mouse; + BEGIN { use_ok('Mouse::Util::TypeConstraints'); } @@ -48,11 +51,12 @@ lives_ok { => via { HTTPHeader->new(hash => $_[0]) }; } 'coercion of anonymous subtype succeeds'; +=pod + foreach my $coercion ( find_type_constraint('Header')->coercion, $anon_type->coercion ) { - isa_ok($coercion, 'Mouse::Meta::TypeCoercion'); { @@ -89,6 +93,8 @@ foreach my $coercion ( } } +=cut + subtype 'StrWithTrailingX' => as 'Str' => where { /X$/ }; diff --git a/t/040_type_constraints/failing/007_util_more_type_coercion.t b/t/040_type_constraints/007_util_more_type_coercion.t similarity index 100% rename from t/040_type_constraints/failing/007_util_more_type_coercion.t rename to t/040_type_constraints/007_util_more_type_coercion.t diff --git a/t/040_type_constraints/failing/003_util_std_type_constraints.t b/t/040_type_constraints/failing/003_util_std_type_constraints.t deleted file mode 100644 index 6ba81b7..0000000 --- a/t/040_type_constraints/failing/003_util_std_type_constraints.t +++ /dev/null @@ -1,358 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 297; -use Test::Exception; - -use Scalar::Util (); - -BEGIN { - use_ok('Mouse::Util::TypeConstraints'); -} - -my $SCALAR_REF = \(my $var); - -no warnings 'once'; # << I *hates* that warning ... -my $GLOB = *GLOB_REF; -my $GLOB_REF = \$GLOB; - -my $fh; -open($fh, '<', $0) || die "Could not open $0 for the test"; - -my $fh_obj = bless {}, "IO::Handle"; # not really - -Mouse::Util::TypeConstraints->export_type_constraints_as_functions(); - -ok(defined Any(0), '... Any accepts anything'); -ok(defined Any(100), '... Any accepts anything'); -ok(defined Any(''), '... Any accepts anything'); -ok(defined Any('Foo'), '... Any accepts anything'); -ok(defined Any([]), '... Any accepts anything'); -ok(defined Any({}), '... Any accepts anything'); -ok(defined Any(sub {}), '... Any accepts anything'); -ok(defined Any($SCALAR_REF), '... Any accepts anything'); -ok(defined Any($GLOB), '... Any accepts anything'); -ok(defined Any($GLOB_REF), '... Any accepts anything'); -ok(defined Any($fh), '... Any accepts anything'); -ok(defined Any(qr/../), '... Any accepts anything'); -ok(defined Any(bless {}, 'Foo'), '... Any accepts anything'); -ok(defined Any(undef), '... Any accepts anything'); - -ok(defined Item(0), '... Item is the base type, so accepts anything'); -ok(defined Item(100), '... Item is the base type, so accepts anything'); -ok(defined Item(''), '... Item is the base type, so accepts anything'); -ok(defined Item('Foo'), '... Item is the base type, so accepts anything'); -ok(defined Item([]), '... Item is the base type, so accepts anything'); -ok(defined Item({}), '... Item is the base type, so accepts anything'); -ok(defined Item(sub {}), '... Item is the base type, so accepts anything'); -ok(defined Item($SCALAR_REF), '... Item is the base type, so accepts anything'); -ok(defined Item($GLOB), '... Item is the base type, so accepts anything'); -ok(defined Item($GLOB_REF), '... Item is the base type, so accepts anything'); -ok(defined Item($fh), '... Item is the base type, so accepts anything'); -ok(defined Item(qr/../), '... Item is the base type, so accepts anything'); -ok(defined Item(bless {}, 'Foo'), '... Item is the base type, so accepts anything'); -ok(defined Item(undef), '... Item is the base type, so accepts anything'); - -ok(defined Defined(0), '... Defined accepts anything which is defined'); -ok(defined Defined(100), '... Defined accepts anything which is defined'); -ok(defined Defined(''), '... Defined accepts anything which is defined'); -ok(defined Defined('Foo'), '... Defined accepts anything which is defined'); -ok(defined Defined([]), '... Defined accepts anything which is defined'); -ok(defined Defined({}), '... Defined accepts anything which is defined'); -ok(defined Defined(sub {}), '... Defined accepts anything which is defined'); -ok(defined Defined($SCALAR_REF), '... Defined accepts anything which is defined'); -ok(defined Defined($GLOB), '... Defined accepts anything which is defined'); -ok(defined Defined($GLOB_REF), '... Defined accepts anything which is defined'); -ok(defined Defined($fh), '... Defined accepts anything which is defined'); -ok(defined Defined(qr/../), '... Defined accepts anything which is defined'); -ok(defined Defined(bless {}, 'Foo'), '... Defined accepts anything which is defined'); -ok(!defined Defined(undef), '... Defined accepts anything which is defined'); - -ok(!defined Undef(0), '... Undef accepts anything which is not defined'); -ok(!defined Undef(100), '... Undef accepts anything which is not defined'); -ok(!defined Undef(''), '... Undef accepts anything which is not defined'); -ok(!defined Undef('Foo'), '... Undef accepts anything which is not defined'); -ok(!defined Undef([]), '... Undef accepts anything which is not defined'); -ok(!defined Undef({}), '... Undef accepts anything which is not defined'); -ok(!defined Undef(sub {}), '... Undef accepts anything which is not defined'); -ok(!defined Undef($SCALAR_REF), '... Undef accepts anything which is not defined'); -ok(!defined Undef($GLOB), '... Undef accepts anything which is not defined'); -ok(!defined Undef($GLOB_REF), '... Undef accepts anything which is not defined'); -ok(!defined Undef($fh), '... Undef accepts anything which is not defined'); -ok(!defined Undef(qr/../), '... Undef accepts anything which is not defined'); -ok(!defined Undef(bless {}, 'Foo'), '... Undef accepts anything which is not defined'); -ok(defined Undef(undef), '... Undef accepts anything which is not defined'); - -ok(defined Bool(0), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(defined Bool(1), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool(100), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(defined Bool(''), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool('Foo'), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool([]), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool({}), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool(sub {}), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool($SCALAR_REF), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool($GLOB), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool($GLOB_REF), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool($fh), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool(qr/../), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(!defined Bool(bless {}, 'Foo'), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); -ok(defined Bool(undef), '... Bool rejects anything which is not a 1 or 0 or "" or undef'); - -ok(defined Value(0), '... Value accepts anything which is not a Ref'); -ok(defined Value(100), '... Value accepts anything which is not a Ref'); -ok(defined Value(''), '... Value accepts anything which is not a Ref'); -ok(defined Value('Foo'), '... Value accepts anything which is not a Ref'); -ok(!defined Value([]), '... Value rejects anything which is not a Value'); -ok(!defined Value({}), '... Value rejects anything which is not a Value'); -ok(!defined Value(sub {}), '... Value rejects anything which is not a Value'); -ok(!defined Value($SCALAR_REF), '... Value rejects anything which is not a Value'); -ok(defined Value($GLOB), '... Value accepts anything which is not a Ref'); -ok(!defined Value($GLOB_REF), '... Value rejects anything which is not a Value'); -ok(!defined Value($fh), '... Value rejects anything which is not a Value'); -ok(!defined Value(qr/../), '... Value rejects anything which is not a Value'); -ok(!defined Value(bless {}, 'Foo'), '... Value rejects anything which is not a Value'); -ok(!defined Value(undef), '... Value rejects anything which is not a Value'); - -ok(!defined Ref(0), '... Ref accepts anything which is not a Value'); -ok(!defined Ref(100), '... Ref accepts anything which is not a Value'); -ok(!defined Ref(''), '... Ref accepts anything which is not a Value'); -ok(!defined Ref('Foo'), '... Ref accepts anything which is not a Value'); -ok(defined Ref([]), '... Ref rejects anything which is not a Ref'); -ok(defined Ref({}), '... Ref rejects anything which is not a Ref'); -ok(defined Ref(sub {}), '... Ref rejects anything which is not a Ref'); -ok(defined Ref($SCALAR_REF), '... Ref rejects anything which is not a Ref'); -ok(!defined Ref($GLOB), '... Ref accepts anything which is not a Value'); -ok(defined Ref($GLOB_REF), '... Ref rejects anything which is not a Ref'); -ok(defined Ref($fh), '... Ref rejects anything which is not a Ref'); -ok(defined Ref(qr/../), '... Ref rejects anything which is not a Ref'); -ok(defined Ref(bless {}, 'Foo'), '... Ref rejects anything which is not a Ref'); -ok(!defined Ref(undef), '... Ref rejects anything which is not a Ref'); - -ok(defined Int(0), '... Int accepts anything which is an Int'); -ok(defined Int(100), '... Int accepts anything which is an Int'); -ok(!defined Int(0.5), '... Int accepts anything which is not a Int'); -ok(!defined Int(100.01), '... Int accepts anything which is not a Int'); -ok(!defined Int(''), '... Int rejects anything which is not a Int'); -ok(!defined Int('Foo'), '... Int rejects anything which is not a Int'); -ok(!defined Int([]), '... Int rejects anything which is not a Int'); -ok(!defined Int({}), '... Int rejects anything which is not a Int'); -ok(!defined Int(sub {}), '... Int rejects anything which is not a Int'); -ok(!defined Int($SCALAR_REF), '... Int rejects anything which is not a Int'); -ok(!defined Int($GLOB), '... Int rejects anything which is not a Int'); -ok(!defined Int($GLOB_REF), '... Int rejects anything which is not a Int'); -ok(!defined Int($fh), '... Int rejects anything which is not a Int'); -ok(!defined Int(qr/../), '... Int rejects anything which is not a Int'); -ok(!defined Int(bless {}, 'Foo'), '... Int rejects anything which is not a Int'); -ok(!defined Int(undef), '... Int rejects anything which is not a Int'); - -ok(defined Num(0), '... Num accepts anything which is an Num'); -ok(defined Num(100), '... Num accepts anything which is an Num'); -ok(defined Num(0.5), '... Num accepts anything which is an Num'); -ok(defined Num(100.01), '... Num accepts anything which is an Num'); -ok(!defined Num(''), '... Num rejects anything which is not a Num'); -ok(!defined Num('Foo'), '... Num rejects anything which is not a Num'); -ok(!defined Num([]), '... Num rejects anything which is not a Num'); -ok(!defined Num({}), '... Num rejects anything which is not a Num'); -ok(!defined Num(sub {}), '... Num rejects anything which is not a Num'); -ok(!defined Num($SCALAR_REF), '... Num rejects anything which is not a Num'); -ok(!defined Num($GLOB), '... Num rejects anything which is not a Num'); -ok(!defined Num($GLOB_REF), '... Num rejects anything which is not a Num'); -ok(!defined Num($fh), '... Num rejects anything which is not a Num'); -ok(!defined Num(qr/../), '... Num rejects anything which is not a Num'); -ok(!defined Num(bless {}, 'Foo'), '... Num rejects anything which is not a Num'); -ok(!defined Num(undef), '... Num rejects anything which is not a Num'); - -ok(defined Str(0), '... Str accepts anything which is a Str'); -ok(defined Str(100), '... Str accepts anything which is a Str'); -ok(defined Str(''), '... Str accepts anything which is a Str'); -ok(defined Str('Foo'), '... Str accepts anything which is a Str'); -ok(!defined Str([]), '... Str rejects anything which is not a Str'); -ok(!defined Str({}), '... Str rejects anything which is not a Str'); -ok(!defined Str(sub {}), '... Str rejects anything which is not a Str'); -ok(!defined Str($SCALAR_REF), '... Str rejects anything which is not a Str'); -ok(!defined Str($fh), '... Str rejects anything which is not a Str'); -ok(!defined Str($GLOB), '... Str rejects anything which is not a Str'); -ok(!defined Str($GLOB_REF), '... Str rejects anything which is not a Str'); -ok(!defined Str(qr/../), '... Str rejects anything which is not a Str'); -ok(!defined Str(bless {}, 'Foo'), '... Str rejects anything which is not a Str'); -ok(!defined Str(undef), '... Str rejects anything which is not a Str'); - -ok(!defined ScalarRef(0), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(100), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(''), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef('Foo'), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef([]), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef({}), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(sub {}), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(defined ScalarRef($SCALAR_REF), '... ScalarRef accepts anything which is a ScalarRef'); -ok(!defined ScalarRef($GLOB), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef($GLOB_REF), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef($fh), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(qr/../), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(bless {}, 'Foo'), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined ScalarRef(undef), '... ScalarRef rejects anything which is not a ScalarRef'); - -ok(!defined ArrayRef(0), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(100), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(''), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef('Foo'), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(defined ArrayRef([]), '... ArrayRef accepts anything which is a ArrayRef'); -ok(!defined ArrayRef({}), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(sub {}), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef($SCALAR_REF), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef($GLOB), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef($GLOB_REF), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef($fh), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(qr/../), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(bless {}, 'Foo'), '... ArrayRef rejects anything which is not a ArrayRef'); -ok(!defined ArrayRef(undef), '... ArrayRef rejects anything which is not a ArrayRef'); - -ok(!defined HashRef(0), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef(100), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef(''), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef('Foo'), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef([]), '... HashRef rejects anything which is not a HashRef'); -ok(defined HashRef({}), '... HashRef accepts anything which is a HashRef'); -ok(!defined HashRef(sub {}), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef($SCALAR_REF), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef($GLOB), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef($GLOB_REF), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef($fh), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef(qr/../), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef(bless {}, 'Foo'), '... HashRef rejects anything which is not a HashRef'); -ok(!defined HashRef(undef), '... HashRef rejects anything which is not a HashRef'); - -ok(!defined CodeRef(0), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef(100), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef(''), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef('Foo'), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef([]), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef({}), '... CodeRef rejects anything which is not a CodeRef'); -ok(defined CodeRef(sub {}), '... CodeRef accepts anything which is a CodeRef'); -ok(!defined CodeRef($SCALAR_REF), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef($GLOB), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef($GLOB_REF), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef($fh), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef(qr/../), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef(bless {}, 'Foo'), '... CodeRef rejects anything which is not a CodeRef'); -ok(!defined CodeRef(undef), '... CodeRef rejects anything which is not a CodeRef'); - -ok(!defined RegexpRef(0), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef(100), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef(''), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef('Foo'), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef([]), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef({}), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef(sub {}), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef($SCALAR_REF), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef($GLOB), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef($GLOB_REF), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef($fh), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(defined RegexpRef(qr/../), '... RegexpRef accepts anything which is a RegexpRef'); -ok(!defined RegexpRef(bless {}, 'Foo'), '... RegexpRef rejects anything which is not a RegexpRef'); -ok(!defined RegexpRef(undef), '... RegexpRef rejects anything which is not a RegexpRef'); - -ok(!defined GlobRef(0), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(100), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(''), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef('Foo'), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef([]), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef({}), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(sub {}), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef($SCALAR_REF), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef($GLOB), '... GlobRef rejects anything which is not a GlobRef'); -ok(defined GlobRef($GLOB_REF), '... GlobRef accepts anything which is a GlobRef'); -ok(defined GlobRef($fh), '... GlobRef accepts anything which is a GlobRef'); -ok(!defined GlobRef($fh_obj), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(qr/../), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(bless {}, 'Foo'), '... GlobRef rejects anything which is not a GlobRef'); -ok(!defined GlobRef(undef), '... GlobRef rejects anything which is not a GlobRef'); - -ok(!defined FileHandle(0), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle(100), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle(''), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle('Foo'), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle([]), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle({}), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle(sub {}), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle($SCALAR_REF), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle($GLOB), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle($GLOB_REF), '... FileHandle rejects anything which is not a FileHandle'); -ok(defined FileHandle($fh), '... FileHandle accepts anything which is a FileHandle'); -ok(defined FileHandle($fh_obj), '... FileHandle accepts anything which is a FileHandle'); -ok(!defined FileHandle(qr/../), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle(bless {}, 'Foo'), '... FileHandle rejects anything which is not a FileHandle'); -ok(!defined FileHandle(undef), '... FileHandle rejects anything which is not a FileHandle'); - -ok(!defined Object(0), '... Object rejects anything which is not blessed'); -ok(!defined Object(100), '... Object rejects anything which is not blessed'); -ok(!defined Object(''), '... Object rejects anything which is not blessed'); -ok(!defined Object('Foo'), '... Object rejects anything which is not blessed'); -ok(!defined Object([]), '... Object rejects anything which is not blessed'); -ok(!defined Object({}), '... Object rejects anything which is not blessed'); -ok(!defined Object(sub {}), '... Object rejects anything which is not blessed'); -ok(!defined Object($SCALAR_REF), '... Object rejects anything which is not blessed'); -ok(!defined Object($GLOB), '... Object rejects anything which is not blessed'); -ok(!defined Object($GLOB_REF), '... Object rejects anything which is not blessed'); -ok(!defined Object($fh), '... Object rejects anything which is not blessed'); -ok(!defined Object(qr/../), '... Object rejects anything which is not blessed'); -ok(defined Object(bless {}, 'Foo'), '... Object accepts anything which is blessed'); -ok(!defined Object(undef), '... Object accepts anything which is blessed'); - -ok(!defined ClassName(0), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(100), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(''), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName('Baz'), '... ClassName rejects anything which is not a ClassName'); - -{ - package Quux::Wibble; # this makes Quux symbol table exist - - sub foo {} -} - -ok(!defined ClassName('Quux'), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName([]), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName({}), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(sub {}), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName($SCALAR_REF), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName($fh), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName($GLOB), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName($GLOB_REF), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(qr/../), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(bless {}, 'Foo'), '... ClassName rejects anything which is not a ClassName'); -ok(!defined ClassName(undef), '... ClassName rejects anything which is not a ClassName'); -ok(defined ClassName('UNIVERSAL'), '... ClassName accepts anything which is a ClassName'); -ok(defined ClassName('Quux::Wibble'), '... ClassName accepts anything which is a ClassName'); -ok(defined ClassName('Mouse::Meta::TypeConstraint'), '... ClassName accepts anything which is a ClassName'); - -ok(!defined RoleName(0), '... RoleName rejects anything which is not a RoleName'); -ok(!defined RoleName(100), '... RoleName rejects anything which is not a RoleName'); -ok(!defined RoleName(''), '... RoleName rejects anything which is not a RoleName'); -ok(!defined RoleName('Baz'), '... RoleName rejects anything which is not a RoleName'); - -{ - package Quux::Wibble::Role; # this makes Quux symbol table exist - use Mouse::Role; - sub foo {} -} - -ok(!defined RoleName('Quux'), '... RoleName rejects anything which is not a RoleName'); -ok(!defined RoleName([]), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName({}), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName(sub {}), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName($SCALAR_REF), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName($fh), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName($GLOB), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName($GLOB_REF), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName(qr/../), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName(bless {}, 'Foo'), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName(undef), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName('UNIVERSAL'), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName('Quux::Wibble'), '... Rolename rejects anything which is not a RoleName'); -ok(!defined RoleName('Mouse::Meta::TypeConstraint'), '... RoleName accepts anything which is a RoleName'); -ok(defined RoleName('Quux::Wibble::Role'), '... RoleName accepts anything which is a RoleName'); - -close($fh) || die "Could not close the filehandle $0 for test"; diff --git a/t/040_type_constraints/failing/009_union_types_and_coercions.t b/t/040_type_constraints/failing/009_union_types_and_coercions.t deleted file mode 100644 index 5dd13ea..0000000 --- a/t/040_type_constraints/failing/009_union_types_and_coercions.t +++ /dev/null @@ -1,162 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; -use Test::Exception; - -BEGIN { - eval "use IO::String; use IO::File;"; - plan skip_all => "IO::String and IO::File are required for this test" if $@; - plan tests => 28; -} - - - -{ - package Email::Mouse; - use Mouse; - use Mouse::Util::TypeConstraints; - - use IO::String; - - our $VERSION = '0.01'; - - # create subtype for IO::String - - subtype 'IO::String' - => as 'Object' - => where { $_->isa('IO::String') }; - - coerce 'IO::String' - => from 'Str' - => via { IO::String->new($_) }, - => from 'ScalarRef', - => via { IO::String->new($_) }; - - # create subtype for IO::File - - subtype 'IO::File' - => as 'Object' - => where { $_->isa('IO::File') }; - - coerce 'IO::File' - => from 'FileHandle' - => via { bless $_, 'IO::File' }; - - # create the alias - - subtype 'IO::StringOrFile' => as 'IO::String | IO::File'; - - # attributes - - has 'raw_body' => ( - is => 'rw', - isa => 'IO::StringOrFile', - coerce => 1, - default => sub { IO::String->new() }, - ); - - sub as_string { - my ($self) = @_; - my $fh = $self->raw_body(); - return do { local $/; <$fh> }; - } -} - -{ - my $email = Email::Mouse->new; - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::String'); - - is($email->as_string, undef, '... got correct empty string'); -} - -{ - my $email = Email::Mouse->new(raw_body => '... this is my body ...'); - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::String'); - - is($email->as_string, '... this is my body ...', '... got correct string'); - - lives_ok { - $email->raw_body('... this is the next body ...'); - } '... this will coerce correctly'; - - isa_ok($email->raw_body, 'IO::String'); - - is($email->as_string, '... this is the next body ...', '... got correct string'); -} - -{ - my $str = '... this is my body (ref) ...'; - - my $email = Email::Mouse->new(raw_body => \$str); - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::String'); - - is($email->as_string, $str, '... got correct string'); - - my $str2 = '... this is the next body (ref) ...'; - - lives_ok { - $email->raw_body(\$str2); - } '... this will coerce correctly'; - - isa_ok($email->raw_body, 'IO::String'); - - is($email->as_string, $str2, '... got correct string'); -} - -{ - my $io_str = IO::String->new('... this is my body (IO::String) ...'); - - my $email = Email::Mouse->new(raw_body => $io_str); - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::String'); - is($email->raw_body, $io_str, '... and it is the one we expected'); - - is($email->as_string, '... this is my body (IO::String) ...', '... got correct string'); - - my $io_str2 = IO::String->new('... this is the next body (IO::String) ...'); - - lives_ok { - $email->raw_body($io_str2); - } '... this will coerce correctly'; - - isa_ok($email->raw_body, 'IO::String'); - is($email->raw_body, $io_str2, '... and it is the one we expected'); - - is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string'); -} - -{ - my $fh; - - open($fh, '<', $0) || die "Could not open $0"; - - my $email = Email::Mouse->new(raw_body => $fh); - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::File'); - - close($fh); -} - -{ - my $fh = IO::File->new($0); - - my $email = Email::Mouse->new(raw_body => $fh); - isa_ok($email, 'Email::Mouse'); - - isa_ok($email->raw_body, 'IO::File'); - is($email->raw_body, $fh, '... and it is the one we expected'); -} - - - diff --git a/t/040_type_constraints/failing/012_container_type_coercion.t b/t/040_type_constraints/failing/012_container_type_coercion.t index e344587..798a448 100644 --- a/t/040_type_constraints/failing/012_container_type_coercion.t +++ b/t/040_type_constraints/failing/012_container_type_coercion.t @@ -3,12 +3,11 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 9; use Test::Exception; BEGIN { use_ok('Mouse::Util::TypeConstraints'); - use_ok('Mouse::Meta::TypeConstraint::Parameterized'); } my $r = Mouse::Util::TypeConstraints->get_type_constraint_registry; diff --git a/t/040_type_constraints/failing/015_enum.t b/t/040_type_constraints/failing/015_enum.t deleted file mode 100644 index 940a341..0000000 --- a/t/040_type_constraints/failing/015_enum.t +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; - -use Scalar::Util (); - -use Mouse::Util::TypeConstraints; - -enum Letter => 'a'..'z', 'A'..'Z'; -enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;) -enum Metacharacter => ['*', '+', '?', '.', '|', '(', ')', '[', ']', '\\']; - -my @valid_letters = ('a'..'z', 'A'..'Z'); - -my @invalid_letters = qw/ab abc abcd/; -push @invalid_letters, qw/0 4 9 ~ @ $ %/; -push @invalid_letters, qw/l33t st3v4n 3num/; - -my @valid_languages = ('Perl 5', 'Perl 6', 'PASM', 'PIR'); -my @invalid_languages = ('perl 5', 'Python', 'Ruby', 'Perl 666', 'PASM++'); -# note that "perl 5" is invalid because case now matters - -my @valid_metacharacters = (qw/* + ? . | ( ) [ ] /, '\\'); -my @invalid_metacharacters = qw/< > & % $ @ ! ~ `/; -push @invalid_metacharacters, qw/.* fish(sticks)? atreides/; -push @invalid_metacharacters, '^1?$|^(11+?)\1+$'; - -plan tests => @valid_letters + @invalid_letters - + @valid_languages + @invalid_languages - + @valid_metacharacters + @invalid_metacharacters - + @valid_languages + 10; - -Mouse::Util::TypeConstraints->export_type_constraints_as_functions(); - -ok(Letter($_), "'$_' is a letter") for @valid_letters; -ok(!Letter($_), "'$_' is not a letter") for @invalid_letters; - -ok(Language($_), "'$_' is a language") for @valid_languages; -ok(!Language($_), "'$_' is not a language") for @invalid_languages; - -ok(Metacharacter($_), "'$_' is a metacharacter") for @valid_metacharacters; -ok(!Metacharacter($_), "'$_' is not a metacharacter") - for @invalid_metacharacters; - -# check anon enums - -my $anon_enum = enum \@valid_languages; -isa_ok($anon_enum, 'Mouse::Meta::TypeConstraint'); - -is($anon_enum->name, '__ANON__', '... got the right name'); -is($anon_enum->parent->name, 'Str', '... got the right parent name'); - -ok($anon_enum->check($_), "'$_' is a language") for @valid_languages; - - -ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" ); -ok( $anon_enum->equals( $anon_enum ), "equals itself" ); -ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" ); - -ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object'); -ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object'); - -ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type'); -ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type'); - diff --git a/t/040_type_constraints/failing/017_subtyping_union_types.t b/t/040_type_constraints/failing/017_subtyping_union_types.t deleted file mode 100644 index 85768ac..0000000 --- a/t/040_type_constraints/failing/017_subtyping_union_types.t +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 21; -use Test::Exception; - -BEGIN { - use_ok("Mouse::Util::TypeConstraints"); -} - -lives_ok { - subtype 'MyCollections' => as 'ArrayRef | HashRef'; -} '... created the subtype special okay'; - -{ - my $t = find_type_constraint('MyCollections'); - isa_ok($t, 'Mouse::Meta::TypeConstraint'); - - is($t->name, 'MyCollections', '... name is correct'); - - my $p = $t->parent; - isa_ok($p, 'Mouse::Meta::TypeConstraint::Union'); - isa_ok($p, 'Mouse::Meta::TypeConstraint'); - - is($p->name, 'ArrayRef|HashRef', '... parent name is correct'); - - ok($t->check([]), '... validated it correctly'); - ok($t->check({}), '... validated it correctly'); - ok(!$t->check(1), '... validated it correctly'); -} - -lives_ok { - subtype 'MyCollectionsExtended' - => as 'ArrayRef|HashRef' - => where { - if (ref($_) eq 'ARRAY') { - return if scalar(@$_) < 2; - } - elsif (ref($_) eq 'HASH') { - return if scalar(keys(%$_)) < 2; - } - 1; - }; -} '... created the subtype special okay'; - -{ - my $t = find_type_constraint('MyCollectionsExtended'); - isa_ok($t, 'Mouse::Meta::TypeConstraint'); - - is($t->name, 'MyCollectionsExtended', '... name is correct'); - - my $p = $t->parent; - isa_ok($p, 'Mouse::Meta::TypeConstraint::Union'); - isa_ok($p, 'Mouse::Meta::TypeConstraint'); - - is($p->name, 'ArrayRef|HashRef', '... parent name is correct'); - - ok(!$t->check([]), '... validated it correctly'); - ok($t->check([1, 2]), '... validated it correctly'); - - ok(!$t->check({}), '... validated it correctly'); - ok($t->check({ one => 1, two => 2 }), '... validated it correctly'); - - ok(!$t->check(1), '... validated it correctly'); -} - - diff --git a/t/040_type_constraints/failing/025_type_coersion_on_lazy_attributes.t b/t/040_type_constraints/failing/025_type_coersion_on_lazy_attributes.t deleted file mode 100644 index 745a4ce..0000000 --- a/t/040_type_constraints/failing/025_type_coersion_on_lazy_attributes.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 2; - -{ - package SomeClass; - use Mouse; - use Mouse::Util::TypeConstraints; - - subtype 'DigitSix' => as 'Num' - => where { /^6$/ }; - subtype 'TextSix' => as 'Str' - => where { /Six/i }; - coerce 'TextSix' - => from 'DigitSix' - => via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' }; - - has foo => ( - is => 'ro', - isa => 'TextSix', - coerce => 1, - default => 6, - lazy => 1 - ); -} - -my $attr = SomeClass->meta->get_attribute('foo'); -is($attr->get_value(SomeClass->new()), 'Six'); -is(SomeClass->new()->foo, 'Six'); -