summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-07-07 01:13:40 -0500
committerJesse Luehrs <doy@tozt.net>2011-07-07 01:13:40 -0500
commit08deb3ba21d0373d40fe0f5660c1e2621f61d0fa (patch)
tree357b8d1b9869a99f4b85074a82c5c808243fd406 /lib
parent93fb77c98e002f21858fe9efa1bf6a8ce2144178 (diff)
downloadsmartmatch-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.pm17
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') {