diff options
| -rw-r--r-- | ext/XS-APItest/Makefile.PL | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/t/sv_numeq.t | 16 | ||||
| -rw-r--r-- | sv.c | 11 |
3 files changed, 27 insertions, 2 deletions
diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL index 16b024e97c..b666a3d137 100644 --- a/ext/XS-APItest/Makefile.PL +++ b/ext/XS-APItest/Makefile.PL @@ -25,7 +25,7 @@ my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE G_SCALAR G_LIST G_VOID G_DISCARD G_EVAL G_NOARGS G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL G_RETHROW GV_NOADD_NOINIT - SV_GMAGIC + SV_GMAGIC SV_SKIP_OVERLOAD IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY IS_NUMBER_NAN IS_NUMBER_TRAILING PERL_SCAN_TRAILING diff --git a/ext/XS-APItest/t/sv_numeq.t b/ext/XS-APItest/t/sv_numeq.t index d183e67548..1949715f6b 100644 --- a/ext/XS-APItest/t/sv_numeq.t +++ b/ext/XS-APItest/t/sv_numeq.t @@ -1,6 +1,6 @@ #!perl -use Test::More tests => 6; +use Test::More tests => 9; use XS::APItest; my $four = 4; @@ -15,3 +15,17 @@ ok !sv_numeq($six_point_five, 6.6), '$six_point_five == 6.6'; "10" =~ m/(\d+)/; ok !sv_numeq_flags($1, 10, 0), 'sv_numeq_flags with no flags does not GETMAGIC'; ok sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does'; + +# overloading +{ + package AlwaysTen { + use overload + '==' => sub { return $_[1] == 10 }, + '0+' => sub { 123456 }; + } + + ok sv_numeq(bless([], "AlwaysTen"), 10), 'AlwaysTen is 10'; + ok !sv_numeq(bless([], "AlwaysTen"), 11), 'AlwaysTen is not 11'; + + ok !sv_numeq_flags(bless([], "AlwaysTen"), 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD' +} @@ -8187,6 +8187,10 @@ identical. If the flags has the C<SV_GMAGIC> bit set, it handles get-magic too. Will coerce its args to numbers if necessary. Treats C<NULL> as undef. +If flags does not have the C<SV_SKIP_OVERLOAD> set, an attempt to use C<==> +overloading will be made. If such overloading does not exist or the flag is +set, then regular numerical comparison will be used instead. + =for apidoc sv_numeq A convenient shortcut for calling C<sv_numeq_flags> with the C<SV_GMAGIC> @@ -8213,6 +8217,13 @@ Perl_sv_numeq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags) if(!sv2) sv2 = &PL_sv_undef; + if(!(flags & SV_SKIP_OVERLOAD) && + (SvAMAGIC(sv1) || SvAMAGIC(sv2))) { + SV *ret = amagic_call(sv1, sv2, eq_amg, 0); + if(ret) + return SvTRUE(ret); + } + return do_ncmp(sv1, sv2) == 0; } |