diff options
| author | Zefram <zefram@fysh.org> | 2017-11-22 17:23:57 +0000 |
|---|---|---|
| committer | Zefram <zefram@fysh.org> | 2017-11-22 17:23:57 +0000 |
| commit | 5f3202fa3e77c4a20de590df045af4683aaedffa (patch) | |
| tree | 5572a671df6c4586c7d77cf8f98787eb0f457f07 /lib | |
| parent | 5e1cca32ac612f0b59508a99fbff671a693f39b9 (diff) | |
| download | perl-5f3202fa3e77c4a20de590df045af4683aaedffa.tar.gz | |
eviscerate smartmatch
Regularise smartmatch's operand handling, by removing the implicit
enreferencement and just supplying scalar context. Eviscerate its runtime
behaviour, by removing all the matching rules other than rhs overloading.
Overload smartmatching in the Regexp package to perform regexp matching.
There are consequential customisations to autodie, in two areas. Firstly,
autodie::exception objects are matchers, but autodie has been advising
smartmatching with the exception on the lhs. This has to change to the
rhs, in both documentation and tests. Secondly, it uses smartmatching as
part of its hint mechanism. Most of the hint examples, in documentation
and tests, have to change to subroutines, to be portable across Perl
versions.
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/overload.t | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/lib/overload.t b/lib/overload.t index 46b193be21..077a796ce8 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -48,7 +48,7 @@ package main; $| = 1; BEGIN { require './test.pl'; require './charset_tools.pl' } -plan tests => 5331; +plan tests => 5385; use Scalar::Util qw(tainted); @@ -1622,6 +1622,11 @@ foreach my $op (qw(<=> == != < <= > >=)) { is($y, $o, "copy constructor falls back to assignment (preinc)"); } +{ + package MatchAbc; + use overload '~~' => sub { $_[1] eq "abc" }; +} + # only scalar 'x' should currently overload { @@ -1835,7 +1840,10 @@ foreach my $op (qw(<=> == != < <= > >=)) { $e = '"abc" ~~ (%s)'; $subs{'~~'} = $e; - push @tests, [ "abc", $e, '(~~)', '(NM:~~)', [ 1, 1, 0 ], 0 ]; + push @tests, [ bless({}, "MatchAbc"), $e, '(~~)', '(NM:~~)', + [ 1, 1, 0 ], 0 ]; + $e = '(%s) ~~ bless({}, "MatchAbc")'; + push @tests, [ "xyz", $e, '(eq)', '(NM:eq)', [ 1, 1, 0 ], 0 ]; $subs{'-X'} = 'do { my $f = (%s);' . '$_[1] eq "r" ? (-r ($f)) :' |