summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2014-12-10 18:20:19 -0800
committerFather Chrysostomos <sprout@cpan.org>2014-12-10 20:21:06 -0800
commit93f6e112d1711b0b220ea546f5fcb0f9ef445b66 (patch)
tree6dbeb326dc2c3f21798bc1c2ce3de78155cc5009
parent1d55083cd581c158cb108c021e3625e4686463f8 (diff)
downloadperl-93f6e112d1711b0b220ea546f5fcb0f9ef445b66.tar.gz
Don’t do string overloading for numeric pack fmts
See <20141130160250.GC31019@pjcj.net>. Commit 354b74ae6f broke this.
-rw-r--r--pp_pack.c11
-rw-r--r--t/op/pack.t11
2 files changed, 18 insertions, 4 deletions
diff --git a/pp_pack.c b/pp_pack.c
index eb63db96e8..ad4f186bf9 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2088,10 +2088,12 @@ S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
return SvGROW(sv, len+extend+1);
}
-static void
+static SV *
S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype)
{
SvGETMAGIC(sv);
+ if (UNLIKELY(SvAMAGIC(sv)))
+ sv = sv_2num(sv);
if (UNLIKELY(isinfnansv(sv))) {
const I32 c = TYPE_NO_MODIFIERS(datumtype);
const NV nv = SvNV_nomg(sv);
@@ -2100,10 +2102,13 @@ S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype)
else
Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'", nv, (int) c);
}
+ return sv;
}
-#define SvIV_no_inf(sv,d) (S_sv_check_infnan(aTHX_ sv,d), SvIV_nomg(sv))
-#define SvUV_no_inf(sv,d) (S_sv_check_infnan(aTHX_ sv,d), SvUV_nomg(sv))
+#define SvIV_no_inf(sv,d) \
+ ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvIV_nomg(sv))
+#define SvUV_no_inf(sv,d) \
+ ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvUV_nomg(sv))
STATIC
SV **
diff --git a/t/op/pack.t b/t/op/pack.t
index 2e3c0f5cbd..8b464dd696 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14704;
+plan tests => 14707;
use strict;
use warnings qw(FATAL all);
@@ -2003,3 +2003,12 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
#90160
is(eval { () = unpack "C0 U*", ""; "ok" }, "ok",
'medial U* on empty string');
+
+package o {
+ use overload
+ '""' => sub { ++$o::str; "42" },
+ '0+' => sub { ++$o::num; 42 };
+}
+is pack("c", bless [], "o"), chr(42), 'overloading called';
+is $o::str, undef, 'pack "c" does not call string overloading';
+is $o::num, 1, 'pack "c" does call num overloading';