Perl_sv_vcatpvfn_flags: %p and Inf/Nan

sprintf("%p", 0+Inf) should print the address of an SV, not the literal
string "Inf". Ditto NaN.

Similarly, sprintf("%p", $x) should print the address of the $x SV,
not triggering a tie fetch or overload method call, nor using the address
of any SV returned by such calls.

diff --git a/sv.c b/sv.c
index dfdf57b..98179fe 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12216,7 +12216,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
        c = *q++; /* c now holds the conversion type */
 
-        if (argsv && strchr("BbcDdiOopuUXx", c)) {
+        if (argsv && strchr("BbcDdiOouUXx", c)) {
             /* XXX va_arg(*args) case? need peek, use va_copy? */
             SvGETMAGIC(argsv);
             if (UNLIKELY(SvAMAGIC(argsv)))

diff --git a/t/op/infnan.t b/t/op/infnan.t
index 2f69367..9f0ced1 100644 (file)
--- a/t/op/infnan.t
+++ b/t/op/infnan.t
@@ -38,7 +38,7 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
            "NAN(123)");
 
-my @printf_fmt = qw(e f g a d u o i b x p);
+my @printf_fmt = qw(e f g a d u o i b x);
 my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
 my @packf_fmt = qw(f d F);
 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
@@ -539,7 +539,7 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
     my @w;
     local $SIG{__WARN__} = sub { push @w, $_[0] };
 
-    for my $format (qw(B b c D d i O o p U u X x)) {
+    for my $format (qw(B b c D d i O o U u X x)) {
         # skip unportable: j
         for my $size (qw(hh h l q L ll t z)) {
             for my $num ($NInf, $PInf, $NaN) {

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index b2d0c48..c9cfdcf 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -971,4 +971,10 @@ SKIP: {
     like $@, qr/Missing argument for %n in sprintf/, "%n";
 }
 
+# %p of an Inf or Nan address should still print its address, not
+# 'Inf' etc.
+
+like sprintf("%p", 0+'Inf'), qr/^[0-9a-f]+$/, "%p and Inf";
+like sprintf("%p", 0+'NaN'), qr/^[0-9a-f]+$/, "%p and NaN";
+
 done_testing();

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 8adfa4a..d8b906d 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -9,7 +9,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan (tests => 345);
+plan (tests => 343);
 
 use strict;
 use warnings;
@@ -295,7 +295,7 @@ pos$var = 0             ; check_count 'lvalue pos $utf8';
 $dummy=sprintf"%1s",$var; check_count 'sprintf "%1s", $utf8';
 $dummy=sprintf"%.1s",$var; check_count 'sprintf "%.1s", $utf8';
 
-my @fmt = qw(B b c D d i O o p u U X x);
+my @fmt = qw(B b c D d i O o u U X x);
 
 tie $var, "main", 23;
 for (@fmt) {