This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t do string overloading for numeric pack fmts
authorFather Chrysostomos <sprout@cpan.org>
Thu, 11 Dec 2014 02:20:19 +0000 (18:20 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 11 Dec 2014 04:21:06 +0000 (20:21 -0800)
See <20141130160250.GC31019@pjcj.net>.  Commit 354b74ae6f broke this.

pp_pack.c
t/op/pack.t

index eb63db9..ad4f186 100644 (file)
--- 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 **
index 2e3c0f5..8b464dd 100644 (file)
@@ -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';