This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads::shared "$#shared = N" off-by-one error
authorDavid Mitchell <davem@iabyn.com>
Mon, 13 Oct 2014 11:45:14 +0000 (12:45 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 14 Oct 2014 11:33:06 +0000 (12:33 +0100)
RT #122950

    my @a : shared;
    $#a = 3;  # actually set it to 4

There was a simple off-by-one error in the XS code that handled the
STORESIZE tie method (confusing the array size and fill, which differ
by 1).

Amazingly, there was no test for it, and no-one had noticed up until now.

Note that this commit causes three tests in object2.t to fail: this
is because fixing the $#shared bug exposed another bug that was being
masked by this one. They will be fixed in the next commit

dist/threads-shared/lib/threads/shared.pm
dist/threads-shared/shared.xs
dist/threads-shared/t/av_simple.t

index bad2c41..304891c 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.46'; # Please update the pod, too.
+our $VERSION = '1.47'; # Please update the pod, too.
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -195,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.46
+This document describes threads::shared version 1.47
 
 =head1 SYNOPSIS
 
index f59a82a..8e41139 100644 (file)
@@ -1373,7 +1373,7 @@ STORESIZE(SV *obj,IV count)
         dTHXc;
         SV *sobj = SHAREDSV_FROM_OBJ(obj);
         SHARED_EDIT;
-        av_fill((AV*) sobj, count);
+        av_fill((AV*) sobj, count - 1);
         SHARED_RELEASE;
 
 
index 7fab9b2..305c6d5 100644 (file)
@@ -27,7 +27,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..44\n");   ### Number of tests that will be run ###
+    print("1..47\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -130,6 +130,16 @@ ok(37, !defined delete($foo[0]), "Check that delete works from a thread");
 
 ok(44, is_shared(@foo), "Check for sharing");
 
+# RT #122950
+
+@foo = ('a'..'z');
+$#foo = 2;
+
+ok(45, $#foo == 2,        "\$#foo assignment: \$#");
+ok(46, @foo  == 3,        "\$#foo assignment: scalar");
+ok(47, "@foo" eq "a b c", "\$#foo assignment: array interpolation");
+
+
 exit(0);
 
 # EOF