From: Hugo van der Sanden <hv@crypt.org>
Date: Sat, 8 Nov 2008 13:29:57 +0000 (+0000)
Subject: "Perl_newSVpvf("%lld")" is broken
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=53f65a9ef4a04e5ea5160b41d8a2658d35d8f4e5;p=p5sagit%2Fp5-mst-13.2.git

"Perl_newSVpvf("%lld")" is broken
Message-Id: <200811081329.mA8DTv7e018896@zen.crypt.org>

Plus some test cases.

p4raw-id: //depot/perl@34780
---

diff --git a/sv.c b/sv.c
index 65b6249..000cfd2 100644
--- a/sv.c
+++ b/sv.c
@@ -9557,8 +9557,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		case 'l':	iv = va_arg(*args, long); break;
 		case 'V':	iv = va_arg(*args, IV); break;
 		default:	iv = va_arg(*args, int); break;
+		case 'q':
 #ifdef HAS_QUAD
-		case 'q':	iv = va_arg(*args, Quad_t); break;
+				iv = va_arg(*args, Quad_t); break;
+#else
+				goto unknown;
 #endif
 		}
 	    }
@@ -9569,8 +9572,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		case 'l':	iv = (long)tiv; break;
 		case 'V':
 		default:	iv = tiv; break;
+		case 'q':
 #ifdef HAS_QUAD
-		case 'q':	iv = (Quad_t)tiv; break;
+				iv = (Quad_t)tiv; break;
+#else
+				goto unknown;
 #endif
 		}
 	    }
@@ -9642,8 +9648,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		case 'l':  uv = va_arg(*args, unsigned long); break;
 		case 'V':  uv = va_arg(*args, UV); break;
 		default:   uv = va_arg(*args, unsigned); break;
+		case 'q':
 #ifdef HAS_QUAD
-		case 'q':  uv = va_arg(*args, Uquad_t); break;
+			   uv = va_arg(*args, Uquad_t); break;
+#else
+			   goto unknown;
 #endif
 		}
 	    }
@@ -9654,8 +9663,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		case 'l':	uv = (unsigned long)tuv; break;
 		case 'V':
 		default:	uv = tuv; break;
+		case 'q':
 #ifdef HAS_QUAD
-		case 'q':	uv = (Uquad_t)tuv; break;
+				uv = (Uquad_t)tuv; break;
+#else
+				goto unknown;
 #endif
 		}
 	    }
@@ -9941,8 +9953,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		default:	*(va_arg(*args, int*)) = i; break;
 		case 'l':	*(va_arg(*args, long*)) = i; break;
 		case 'V':	*(va_arg(*args, IV*)) = i; break;
+		case 'q':
 #ifdef HAS_QUAD
-		case 'q':	*(va_arg(*args, Quad_t*)) = i; break;
+				*(va_arg(*args, Quad_t*)) = i; break;
+#else
+				goto unknown;
 #endif
 		}
 	    }
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 397c19e..3e608d8 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,10 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 1295;
+plan tests => 1319;
+
+use strict;
+use Config;
 
 is(
     sprintf("%.40g ",0.01),
@@ -139,3 +142,26 @@ foreach my $n (2**1e100, -2**1e100, 2**1e100/2**1e100) { # +Inf, -Inf, NaN
     eval { my $f = sprintf("%f", $n); };
     is $@, "", "sprintf(\"%f\", $n)";
 }
+
+# test %ll formats with and without HAS_QUAD
+eval { my $q = pack "q", 0 };
+my $Q = $@ eq '';
+
+my @tests = (
+  [ '%lld' => '%d', [qw( 4294967296 -100000000000000 )] ],
+  [ '%lli' => '%i', [qw( 4294967296 -100000000000000 )] ],
+  [ '%llu' => '%u', [qw( 4294967296  100000000000000 )] ],
+  [ '%Ld'  => '%d', [qw( 4294967296 -100000000000000 )] ],
+  [ '%Li'  => '%i', [qw( 4294967296 -100000000000000 )] ],
+  [ '%Lu'  => '%u', [qw( 4294967296  100000000000000 )] ],
+);
+
+for my $t (@tests) {
+  my($fmt, $conv) = @$t;
+  for my $num (@{$t->[2]}) {
+    my $w; local $SIG{__WARN__} = sub { $w = shift };
+    is(sprintf($fmt, $num), $Q ? $num : $fmt, "quad: $fmt -> $num");
+    like($w, $Q ? '' : qr/Invalid conversion in sprintf: "$conv"/, "warning: $fmt");
+  }
+}
+