diff options
author | Jesse Luehrs <doy@tozt.net> | 2011-07-07 01:13:40 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2011-07-07 01:13:40 -0500 |
commit | 08deb3ba21d0373d40fe0f5660c1e2621f61d0fa (patch) | |
tree | 357b8d1b9869a99f4b85074a82c5c808243fd406 /lib | |
parent | 93fb77c98e002f21858fe9efa1bf6a8ce2144178 (diff) | |
download | smartmatch-engine-rjbs-08deb3ba21d0373d40fe0f5660c1e2621f61d0fa.tar.gz smartmatch-engine-rjbs-08deb3ba21d0373d40fe0f5660c1e2621f61d0fa.zip |
add the core test suite, and fix a couple bugs it points out
Diffstat (limited to 'lib')
-rw-r--r-- | lib/smartmatch/engine/core.pm | 17 |
1 files changed, 8 insertions, 9 deletions
diff --git a/lib/smartmatch/engine/core.pm b/lib/smartmatch/engine/core.pm index ad25001..c7be71f 100644 --- a/lib/smartmatch/engine/core.pm +++ b/lib/smartmatch/engine/core.pm @@ -12,7 +12,7 @@ sub type { if (!defined($thing)) { return 'undef'; } - elsif (blessed($thing)) { + elsif (blessed($thing) && reftype($thing) ne 'REGEXP') { return 'Object'; } elsif (my $reftype = reftype($thing)) { @@ -57,7 +57,7 @@ sub match { my $overload = overload::Method($b, '~~'); die "no ~~ overloading on $b" unless $overload; - return $overload->($a, 1); + return $b->$overload($a, 1); } elsif (type($b) eq 'CodeRef') { if (type($a) eq 'Hash') { @@ -72,10 +72,10 @@ sub match { } elsif (type($b) eq 'Hash') { if (type($a) eq 'Hash') { - return match([keys %$a], [keys %$b]); + return match([sort keys %$a], [sort keys %$b]); } elsif (type($a) eq 'Array') { - return grep { exists $b->{$_} } @$a; + return grep { defined && exists $b->{$_} } @$a; } elsif (type($a) eq 'Regex') { return grep /$a/, keys %$b; @@ -89,7 +89,7 @@ sub match { } elsif (type($b) eq 'Array') { if (type($a) eq 'Hash') { - return grep { exists $a->{$_} } @$b; + return grep { defined && exists $a->{$_} } @$b; } elsif (type($a) eq 'Array') { return unless @$a == @$b; @@ -121,11 +121,10 @@ sub match { } elsif (type($a) eq 'Object') { my $overload = overload::Method($a, '~~'); - die "no ~~ overloading on $a" - unless $overload; - return $overload->($b, 0); + return $a->$overload($b, 0) if $overload; } - elsif (type($b) eq 'Num') { + + if (type($b) eq 'Num') { return $a == $b; } elsif (type($a) eq 'Num' && type($b) eq 'numish') { |