diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/overload.t | 80 |
1 files changed, 79 insertions, 1 deletions
diff --git a/lib/overload.t b/lib/overload.t index 1f9bc1ba2f..80b4f137f1 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead package main; $| = 1; -use Test::More tests => 577; +use Test::More tests => 598; $a = new Oscalar "087"; @@ -1182,6 +1182,84 @@ foreach my $op (qw(<=> == != < <= > >=)) { } { + { + package QRonly; + use overload qr => sub { qr/x/ }, fallback => 1; + } + { + my $x = bless [], "QRonly"; + + # like tries to be too clever, and decides that $x-stringified + # doesn't look like a regex + ok("x" =~ $x, "qr-only matches"); + ok("xx" =~ /x$x/, "qr-only matches with concat"); + like("$x", qr/QRonly=ARRAY/, "qr-only doesn't have string overload"); + + my $qr = bless qr/y/, "QRonly"; + ok("x" =~ $qr, "qr with qr-overload uses overload"); + is("$qr", "".qr/y/, "qr with qr-overload stringify"); + + my $rx = $$qr; + ok("y" =~ $rx, "bare rx with qr-overload doesn't overload match"); + is("$rx", "".qr/y/, "bare rx with qr-overload stringify"); + } + { + package QRandSTR; + use overload qr => sub { qr/x/ }, q/""/ => sub { "y" }; + } + { + my $x = bless [], "QRandSTR"; + ok("x" =~ $x, "qr+str uses qr for match"); + ok("xx" =~ /x$x/, "qr+str uses qr for match with concat"); + is("$x", "y", "qr+str uses str for stringify"); + + my $qr = bless qr/z/, "QRandSTR"; + is("$qr", "y", "qr with qr+str uses str for stringify"); + ok("xx" =~ /x$x/, "qr with qr+str uses qr for match"); + + my $rx = $$qr; + ok("z" =~ $rx, "bare rx with qr+str doesn't overload match"); + is("$rx", "".qr/z/, "bare rx with qr+str doesn't overload stringify"); + } + { + package QRany; + use overload qr => sub { $_[0]->(@_) }; + + package QRself; + use overload qr => sub { $_[0] }; + } + { + my $rx = bless sub { ${ qr/x/ } }, "QRany"; + ok(eval { "x" =~ $rx }, "qr overload accepts a bare rx"); + + my $str = bless sub { "x" }, "QRany"; + ok(!eval { "x" =~ $str }, "qr overload doesn't accept a string"); + like($@, qr/^qr overload did not return a REGEXP/, "correct error"); + + my $oqr = bless qr/z/, "QRandSTR"; + my $oqro = bless sub { $oqr }, "QRany"; + ok(eval { "z" =~ $oqro }, "qr overload doesn't recurse"); + + my $qrs = bless qr/z/, "QRself"; + ok(eval { "z" =~ $qrs }, "qr overload can return self"); + } + { + package STRonly; + use overload q/""/ => sub { "x" }; + + package STRonlyFB; + use overload q/""/ => sub { "x" }, fallback => 1; + } + { + my $fb = bless [], "STRonlyFB"; + ok(eval { "x" =~ $fb }, "qr falls back to \"\""); + + my $nofb = bless [], "STRonly"; + ok(eval { "x" =~ $nofb }, "qr falls back even without fallback"); + } +} + +{ my $twenty_three = 23; # Check that constant overloading propagates into evals BEGIN { overload::constant integer => sub { 23 } } |