diff options
author | Jesse Luehrs <doy@tozt.net> | 2012-06-23 19:29:23 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2012-06-23 19:29:23 -0500 |
commit | ac8d7eec0033ae938648be9df84fff05f08aae3b (patch) | |
tree | c1c1f043c18e924e09600223d6a594b48e47edc1 | |
parent | 5f9d80285fff821022074addbfd1bf4476da440a (diff) | |
download | smartmatch-ac8d7eec0033ae938648be9df84fff05f08aae3b.tar.gz smartmatch-ac8d7eec0033ae938648be9df84fff05f08aae3b.zip |
add example of object overloading with recursion
-rw-r--r-- | t/sugar.t | 34 |
1 files changed, 33 insertions, 1 deletions
@@ -4,10 +4,14 @@ use warnings; use Test::More; use List::MoreUtils; +use Scalar::Util 'blessed'; { use smartmatch sub { - if (ref($_[1])) { + if (blessed($_[1])) { + return overload::Method($_[1], '~~')->($_[1], $_[0]); + } + elsif (ref($_[1])) { return $_[1]->($_[0]); } else { @@ -17,6 +21,9 @@ use List::MoreUtils; ok("a" ~~ any(1, 2, "foo")); ok(!("a" ~~ any(1, 2, 3))); + + ok("a" ~~ all("foo", "foo", "foo")); + ok(!("a" ~~ all("a", 2, "foo"))); } sub any { @@ -30,4 +37,29 @@ sub any { } } +{ + package Sugar::All; + use overload '~~' => 'sm_overload'; + + sub new { + my $class = shift; + my (%params) = @_; + return bless { rvals => $params{rvals} }, $class; + } + + sub sm_overload { + my $self = shift; + my ($lval) = @_; + + my $recurse = smartmatch::get_smartmatch_callback(1); + return List::MoreUtils::all { $recurse->($lval, $_) } + @{ $self->{rvals} }; + } +} + +sub all { + my @rvals = @_; + return Sugar::All->new(rvals => \@rvals); +} + done_testing; |