Integrate:

[ 22543]
Add a new warning "Negative repeat count"
for the cases $x x -1.

[ 22549]
Finally, this "Negative repeat count" warning wasn't such a great
idea. Disable it. But add tests for this :

Subject: Re: [perl #27811] (@x) x -1 is a panic
Message-ID: <20040321152704.GA9041@petdance.com>
p4raw-link: @22549 on //depot/perl: 3b8c0df9bfb9b3699a23e8633f5ede3b929d4620
p4raw-link: @22543 on //depot/perl: 58a9d1fc4b9782cdc8aaf9dd6fdfa2736076b173

p4raw-id: //depot/maint-5.8/perl@22562
p4raw-integrated: from //depot/perl@22561 'copy in' t/op/repeat.t
	(@13077..) 'merge in' pod/perlop.pod (@22258..)
p4raw-integrated: from //depot/perl@22543 'edit in' pp.c (@22531..)
	'ignore' t/lib/warnings/pp (@14200..)

diff --git a/pod/perlop.pod b/pod/perlop.pod
index 352dedd..8529387 100644 (file)
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -238,7 +238,9 @@ Binary "x" is the repetition operator.  In scalar context or if the left
 operand is not enclosed in parentheses, it returns a string consisting
 of the left operand repeated the number of times specified by the right
 operand.  In list context, if the left operand is enclosed in
-parentheses, it repeats the list.
+parentheses, it repeats the list.  If the right operand is zero or
+negative, it returns an empty string or an empty list, depending on the
+context.
 
     print '-' x 80;            # print row of dashes
 

diff --git a/pp.c b/pp.c
index a959833..d17f025 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1381,6 +1381,8 @@ PP(pp_repeat)
   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
   {
     register IV count = POPi;
+    if (count < 0)
+       count = 0;
     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
        I32 items = SP - MARK;

diff --git a/t/op/repeat.t b/t/op/repeat.t
index 82fcf75..d1b9c94 100755 (executable)
--- a/t/op/repeat.t
+++ b/t/op/repeat.t
@@ -6,13 +6,15 @@ BEGIN {
 }
 
 require './test.pl';
-plan(tests => 25);
+plan(tests => 33);
 
 # compile time
 
 is('-' x 5, '-----',    'compile time x');
 is('-' x 1, '-',        '  x 1');
 is('-' x 0, '',         '  x 0');
+is('-' x -1, '',        '  x -1');
+is('-' x undef, '',     '  x undef');
 
 is('ab' x 3, 'ababab',  '  more than one char');
 
@@ -22,9 +24,15 @@ $a = '-';
 is($a x 5, '-----',     'run time x');
 is($a x 1, '-',         '  x 1');
 is($a x 0, '',          '  x 0');
+is($a x -3, '',         '  x -3');
+is($a x undef, '',      '  x undef');
 
 $a = 'ab';
 is($a x 3, 'ababab',    '  more than one char');
+$a = 'ab';
+is($a x 0, '',          '  more than one char');
+$a = 'ab';
+is($a x -12, '',        '  more than one char');
 
 $a = 'xyz';
 $a x= 2;
@@ -45,6 +53,9 @@ is(join(':', (9) x 4),      '9:9:9:9',              '(X) x Y');
 is(join(':', (9,9) x 4),    '9:9:9:9:9:9:9:9',      '(X,X) x Y');
 is(join('', (split(//,"123")) x 2), '123123',       'split and x');
 
+is(join('', @x x -12),      '',                     '@x x -12');
+is(join('', (@x) x -14),    '',                     '(@x) x -14');
+
 
 # This test is actually testing for Digital C compiler optimizer bug,
 # present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS),