summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordoy <doy@tozt.net>2009-01-12 22:32:51 -0500
committerdoy <doy@tozt.net>2009-01-12 22:32:51 -0500
commitcf05eeb09e4366d7848fb35c1597633f28b4d196 (patch)
tree28e86a9b07c64304b2b165cba33b074d00168cce
parent2e5646ec4862a6627be83101b27d9cebc2c04318 (diff)
downloadmoosex-role-matcher-cf05eeb09e4366d7848fb35c1597633f28b4d196.tar.gz
moosex-role-matcher-cf05eeb09e4366d7848fb35c1597633f28b4d196.zip
add a test file for submatching
-rw-r--r--t/004-submatching.t125
1 files changed, 125 insertions, 0 deletions
diff --git a/t/004-submatching.t b/t/004-submatching.t
new file mode 100644
index 0000000..3afd436
--- /dev/null
+++ b/t/004-submatching.t
@@ -0,0 +1,125 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+package Bar;
+use Moose;
+with 'MooseX::Role::Matcher';
+
+has [qw/a b c/] => (
+ is => 'rw',
+ required => 1,
+);
+
+package Baz;
+use Moose;
+with 'MooseX::Role::Matcher';
+
+has [qw/a b c/] => (
+ is => 'rw',
+ required => 1,
+);
+
+package Foo;
+use Moose;
+with 'MooseX::Role::Matcher';
+
+has bar => (
+ is => 'ro',
+ isa => 'Bar',
+ required => 1,
+);
+
+has baz => (
+ is => 'ro',
+ isa => 'Baz',
+ required => 1,
+);
+
+has [qw/a b c/] => (
+ is => 'ro',
+ required => 1,
+);
+
+package main;
+{
+ my $bar = Bar->new(a => 1, b => 2, c => 3);
+ my $baz = Baz->new(a => 'chess', b => 'go', c => 'nethack');
+ my $foo = Foo->new(bar => $bar, baz => $baz,
+ a => 'foo', b => 'bar', c => 'baz');
+ ok($foo->match(bar => {
+ a => 1,
+ }),
+ 'simple submatching works');
+ ok($foo->match(bar => {
+ b => 2,
+ '!c' => sub { $_ > 5 },
+ }),
+ 'simple submatching works');
+ ok($foo->match(a => 'foo',
+ bar => {
+ b => qr/\d/,
+ a => sub { length == 1 },
+ },
+ baz => {
+ c => 'nethack',
+ a => qr/^c.*s$/
+ },
+ ),
+ 'simple submatching works');
+}
+{
+ my $bar = Bar->new(a => 4, b => 5, c => 6);
+ my $baz = Baz->new(a => $bar, b => 'quux', c => 'cribbage');
+ my $foo = Foo->new(a => 3.14, b => 2.72, c => 1.61,
+ bar => $bar, baz => $baz);
+ ok($foo->match(a => 3.14,
+ bar => {
+ a => 4,
+ },
+ baz => {
+ b => sub { length == 4 },
+ a => {
+ b => 5,
+ c => qr/\d/,
+ },
+ }),
+ 'deeper submatching works');
+}
+{
+ my $bar = Bar->new(a => 7, b => 'tmp', c => 9);
+ my $baz = Baz->new(a => $bar, b => 'quuux', c => 'tmp');
+ my $foo = Foo->new(a => 256, b => 65536, c => 4294967296,
+ bar => $bar, baz => $baz);
+ $bar->b($foo);
+ $baz->c($baz);
+ ok($foo->match(baz => {
+ c => {
+ c => {
+ c => {
+ c => {
+ b => 'quuux',
+ },
+ },
+ },
+ },
+ }),
+ 'cyclical submatching works');
+ ok($foo->match('!b' => sub { $_ % 2 },
+ bar => {
+ a => 7,
+ b => {
+ a => qr/\d+/,
+ baz => {
+ c => {
+ a => {
+ a => 7,
+ b => $foo
+ },
+ },
+ },
+ },
+ }),
+ 'cyclical submatching works');
+}