X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Frepeat.t;h=d1083e8a8f8d680f56aa1ddb38b9b47d642ed74b;hb=809e8e66a971d59a948ca995e08b228927d82c66;hp=f935bf106fac2fc5565cf34e40b73b2fdc9a2fda;hpb=5926133d519625e5c6cc80fa9f5881300623dca1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/repeat.t b/t/op/repeat.t index f935bf1..d1083e8 100755 --- a/t/op/repeat.t +++ b/t/op/repeat.t @@ -1,51 +1,79 @@ #!./perl -# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} -print "1..20\n"; +require './test.pl'; +plan(tests => 42); # compile time -if ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";} -if ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";} -if ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";} +is('-' x 5, '-----', 'compile time x'); +is('-' x 3.1, '---', 'compile time 3.1'); +is('-' x 3.9, '---', 'compile time 3.9'); +is('-' x 1, '-', ' x 1'); +is('-' x 0, '', ' x 0'); +is('-' x -1, '', ' x -1'); +is('-' x undef, '', ' x undef'); +is('-' x "foo", '', ' x "foo"'); +is('-' x "3rd", '---', ' x "3rd"'); -if ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";} +is('ab' x 3, 'ababab', ' more than one char'); # run time $a = '-'; -if ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";} -if ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";} -if ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";} +is($a x 5, '-----', 'run time x'); +is($a x 3.1, '---', ' x 3.1'); +is($a x 3.9, '---', ' x 3.9'); +is($a x 1, '-', ' x 1'); +is($a x 0, '', ' x 0'); +is($a x -3, '', ' x -3'); +is($a x undef, '', ' x undef'); +is($a x "foo", '', ' x "foo"'); +is($a x "3rd", '---', ' x "3rd"'); $a = 'ab'; -if ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";} +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; -if ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";} +is($a, 'xyzxyz', 'x=2'); $a x= 1; -if ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";} +is($a, 'xyzxyz', 'x=1'); $a x= 0; -if ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";} +is($a, '', 'x=0'); @x = (1,2,3); -print join('', @x x 4) eq '3333' ? "ok 12\n" : "not ok 12\n"; -print join('', (@x) x 4) eq '123123123123' ? "ok 13\n" : "not ok 13\n"; -print join('', (@x,()) x 4) eq '123123123123' ? "ok 14\n" : "not ok 14\n"; -print join('', (@x,1) x 4) eq '1231123112311231' ? "ok 15\n" : "not ok 15\n"; -print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n"; -print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n"; -print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n"; -print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n"; +is(join('', @x x 4), '3333', '@x x Y'); +is(join('', (@x) x 4), '123123123123', '(@x) x Y'); +is(join('', (@x,()) x 4), '123123123123', '(@x,()) x Y'); +is(join('', (@x,1) x 4), '1231123112311231', '(@x,1) x Y'); +is(join(':', () x 4), '', '() x Y'); +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), +# found in December 1998. The bug was reported to Digital^WCompaq as +# DECC 2745 (21-Dec-1998) +# GEM_BUGS 7619 (23-Dec-1998) +# As of April 1999 the bug has been fixed in Tru64 UNIX 5.0 and is planned +# to be fixed also in 4.0G. # -# The test #20 is actually testing for Digital C compiler optimizer bug. -# -# Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS) used -# to produce (as of December 1998) broken code for util.c:repeatcpy() +# The bug was as follows: broken code was produced for util.c:repeatcpy() # (a utility function for the 'x' operator) in the case *all* these # four conditions held: # @@ -68,9 +96,6 @@ print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n"; # 24 .........???????.??????? # 25 .........???????.???????. # -# The bug could be (obscurely) avoided by changing "from" to -# be an unsigned char pointer. -# # The bug was triggered in the "if (len == 1)" branch. The fix # was to introduce a new temporary variable. In diff -u format: # @@ -85,9 +110,47 @@ print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n"; # return; # } # +# The bug could also be (obscurely) avoided by changing "from" to +# be an unsigned char pointer. +# # This obscure bug was not found by the then test suite but instead # by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00. # # jhi@iki.fi # -print "\xdd" x 24 eq "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd" ? "ok 20\n" : "not ok 20\n"; +is("\xdd" x 24, "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd", 'Dec C bug'); + + +# When we use a list repeat in a scalar context, it behaves like +# a scalar repeat. Make sure that works properly, and doesn't leave +# extraneous values on the stack. +# -- robin@kitsite.com + +my ($x, $y) = scalar ((1,2)x2); +is($x, "22", 'list repeat in scalar context'); +is($y, undef, ' no extra values on stack'); + +# Make sure the stack doesn't get truncated too much - the left +# operand of the eq binop needs to remain! +is(77, scalar ((1,7)x2), 'stack truncation'); + + +# perlbug 20011113.110 works in 5.6.1, broken in 5.7.2 +{ + my $x= [("foo") x 2]; + is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' ); +} + +# [ID 20010809.028] x operator not copying elements in 'for' list? +{ + local $TODO = "x operator not copying elements in 'for' list? [ID 20010809.028]"; + my $x = 'abcd'; + my $y = ''; + for (($x =~ /./g) x 2) { + $y .= chop; + } + is($y, 'abcdabcd'); +} + +# [perl #35885] +is( (join ',', (qw(a b c) x 3)), 'a,b,c,a,b,c,a,b,c', 'x on qw produces list' );