1#!./perl 2 3# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $ 4 5print "1..20\n"; 6 7# compile time 8 9if ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";} 10if ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";} 11if ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";} 12 13if ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";} 14 15# run time 16 17$a = '-'; 18if ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";} 19if ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";} 20if ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";} 21 22$a = 'ab'; 23if ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";} 24 25$a = 'xyz'; 26$a x= 2; 27if ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";} 28$a x= 1; 29if ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";} 30$a x= 0; 31if ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";} 32 33@x = (1,2,3); 34 35print join('', @x x 4) eq '3333' ? "ok 12\n" : "not ok 12\n"; 36print join('', (@x) x 4) eq '123123123123' ? "ok 13\n" : "not ok 13\n"; 37print join('', (@x,()) x 4) eq '123123123123' ? "ok 14\n" : "not ok 14\n"; 38print join('', (@x,1) x 4) eq '1231123112311231' ? "ok 15\n" : "not ok 15\n"; 39print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n"; 40print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n"; 41print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n"; 42print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n"; 43 44# 45# The test #20 is actually testing for Digital C compiler optimizer bug, 46# present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS), 47# found in December 1998. The bug was reported to Digital^WCompaq as 48# DECC 2745 (21-Dec-1998) 49# GEM_BUGS 7619 (23-Dec-1998) 50# As of April 1999 the bug has been fixed in Tru64 UNIX 5.0 and is planned 51# to be fixed also in 4.0G. 52# 53# The bug was as follows: broken code was produced for util.c:repeatcpy() 54# (a utility function for the 'x' operator) in the case *all* these 55# four conditions held: 56# 57# (1) len == 1 58# (2) "from" had the 8th bit on in its single character 59# (3) count > 7 (the 'x' count > 16) 60# (4) the highest optimization level was used in compilation 61# (which is the default when compiling Perl) 62# 63# The bug looked like this (. being the eight-bit character and ? being \xff): 64# 65# 16 ................ 66# 17 .........???????. 67# 18 .........???????.. 68# 19 .........???????... 69# 20 .........???????.... 70# 21 .........???????..... 71# 22 .........???????...... 72# 23 .........???????....... 73# 24 .........???????.??????? 74# 25 .........???????.???????. 75# 76# The bug was triggered in the "if (len == 1)" branch. The fix 77# was to introduce a new temporary variable. In diff -u format: 78# 79# register char *frombase = from; 80# 81# if (len == 1) { 82#- todo = *from; 83#+ register char c = *from; 84# while (count-- > 0) 85#- *to++ = todo; 86#+ *to++ = c; 87# return; 88# } 89# 90# The bug could also be (obscurely) avoided by changing "from" to 91# be an unsigned char pointer. 92# 93# This obscure bug was not found by the then test suite but instead 94# by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00. 95# 96# jhi@iki.fi 97# 98print "\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"; 99