From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 6 Feb 2008 01:00:43 +0000 (+0000)
Subject: in unpack, () groups in scalar context were still returning a list,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c6f750d1077663994219dbd69f4fb02631f69b10;p=p5sagit%2Fp5-mst-13.2.git

in unpack, () groups in scalar context were still returning a list,
resulting in garbage on the stack, which could manifest as a SEGV
(Bug 50256)

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

diff --git a/pp_pack.c b/pp_pack.c
index 7bf1ce1..98d4869 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1258,6 +1258,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    symptr->previous = &savsym;
             symptr->level++;
 	    PUTBACK;
+	    if (len && unpack_only_one) len = 1;
 	    while (len--) {
   	        symptr->patptr = savsym.grpbeg;
 		if (utf8) symptr->flags |=  FLAG_PARSE_UTF8;
diff --git a/t/op/pack.t b/t/op/pack.t
index 9312646..4b5f9a5 100755
--- 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 => 14696;
+plan tests => 14697;
 
 use strict;
 use warnings qw(FATAL all);
@@ -1980,3 +1980,8 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     is(unpack('@!4 a*', "\x{301}\x{302}\x{303}\x{304}\x{305}"),
        "\x{303}\x{304}\x{305}", 'Test basic utf8 @!');
 }
+{
+    #50256
+    my ($v) = split //, unpack ('(B)*', 'ab');
+    is($v, 0); # Doesn't SEGV :-)
+}