Re: [ID 20000821.008] Negitive numbers with vec dumps core

Message-Id: <E13ReUA-0000vC-00@virgo.cus.cam.ac.uk>

p4raw-id: //depot/perl@6790

4 files changed, 29 insertions, 4 deletions

diff --git a/doop.c b/doop.c
index 074be99e18..3c86690bfb 100644
--- a/doop.c
+++ b/doop.c
@@ -689,6 +689,8 @@ Perl_do_vecset(pTHX_ SV *sv)
     (void)SvPOK_only(targ);
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
+    if (offset < 0)
+	Perl_croak(aTHX_ "Assigning to negative offset in vec");
     size = LvTARGLEN(sv);
     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ 
 	Perl_croak(aTHX_ "Illegal number of bits in vec");
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6f62e3c596..8a37588f3a 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -182,6 +182,11 @@ spots.  This is now heavily deprecated.
 must either both be scalars or both be lists.  Otherwise Perl won't
 know which context to supply to the right side.
 
+=item Assigning to negative offset in vec
+
+(F) The second argument to vec() must refer to an actual element of
+the string if you wish to assign to it.
+
 =item Attempt to bless into a reference
 
 (F) The CLASSNAME argument to the bless() operator is expected to be
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 977261936f..0235c37fed 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -5497,9 +5497,10 @@ to give the expression the correct precedence as in
 
     vec($image, $max_x * $x + $y, 8) = 3;
 
-If the selected element is off the end of the string, the value 0 is
-returned.  If an element off the end of the string is written to,
-Perl will first extend the string with sufficiently many zero bytes.
+If the selected element is outside the string, the value 0 is returned.
+If an element off the end of the string is written to, Perl will first
+extend the string with sufficiently many zero bytes.   It is an error
+to try to write off the beginning of the string (i.e. negative OFFSET).
 
 Strings created with C<vec> can also be manipulated with the logical
 operators C<|>, C<&>, C<^>, and C<~>.  These operators will assume a bit
diff --git a/t/op/vec.t b/t/op/vec.t
index b8efb8011d..52b20cd7fa 100755
--- a/t/op/vec.t
+++ b/t/op/vec.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..18\n";
+print "1..23\n";
 
 print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
 print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
@@ -31,3 +31,20 @@ $baz = $foo | $bar;
 print $foo eq "1" && $foo == 1 ? "ok 16\n" : "not ok 16\n";
 print $bar eq "2" && $bar == 2 ? "ok 17\n" : "not ok 17\n";
 print "$foo $bar $baz" eq "1 2 3" ? "ok 18\n" : "not ok 18\n";
+
+# error cases
+
+$x = eval { vec $foo, 0, 3 };
+print "not " if defined $x or $@ !~ /^Illegal number of bits in vec/;
+print "ok 19\n";
+$x = eval { vec $foo, 0, 0 };
+print "not " if defined $x or $@ !~ /^Illegal number of bits in vec/;
+print "ok 20\n";
+$x = eval { vec $foo, 0, -13 };
+print "not " if defined $x or $@ !~ /^Illegal number of bits in vec/;
+print "ok 21\n";
+$x = eval { vec($foo, -1, 4) = 2 };
+print "not " if defined $x or $@ !~ /^Assigning to negative offset in vec/;
+print "ok 22\n";
+print "not " if vec('abcd', 7, 8);
+print "ok 23\n";