1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gaterequire './test.pl'; 9*0Sstevel@tonic-gateplan(tests => 33); 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate# compile time 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gateis('-' x 5, '-----', 'compile time x'); 14*0Sstevel@tonic-gateis('-' x 1, '-', ' x 1'); 15*0Sstevel@tonic-gateis('-' x 0, '', ' x 0'); 16*0Sstevel@tonic-gateis('-' x -1, '', ' x -1'); 17*0Sstevel@tonic-gateis('-' x undef, '', ' x undef'); 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateis('ab' x 3, 'ababab', ' more than one char'); 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gate# run time 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gate$a = '-'; 24*0Sstevel@tonic-gateis($a x 5, '-----', 'run time x'); 25*0Sstevel@tonic-gateis($a x 1, '-', ' x 1'); 26*0Sstevel@tonic-gateis($a x 0, '', ' x 0'); 27*0Sstevel@tonic-gateis($a x -3, '', ' x -3'); 28*0Sstevel@tonic-gateis($a x undef, '', ' x undef'); 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate$a = 'ab'; 31*0Sstevel@tonic-gateis($a x 3, 'ababab', ' more than one char'); 32*0Sstevel@tonic-gate$a = 'ab'; 33*0Sstevel@tonic-gateis($a x 0, '', ' more than one char'); 34*0Sstevel@tonic-gate$a = 'ab'; 35*0Sstevel@tonic-gateis($a x -12, '', ' more than one char'); 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate$a = 'xyz'; 38*0Sstevel@tonic-gate$a x= 2; 39*0Sstevel@tonic-gateis($a, 'xyzxyz', 'x=2'); 40*0Sstevel@tonic-gate$a x= 1; 41*0Sstevel@tonic-gateis($a, 'xyzxyz', 'x=1'); 42*0Sstevel@tonic-gate$a x= 0; 43*0Sstevel@tonic-gateis($a, '', 'x=0'); 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate@x = (1,2,3); 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateis(join('', @x x 4), '3333', '@x x Y'); 48*0Sstevel@tonic-gateis(join('', (@x) x 4), '123123123123', '(@x) x Y'); 49*0Sstevel@tonic-gateis(join('', (@x,()) x 4), '123123123123', '(@x,()) x Y'); 50*0Sstevel@tonic-gateis(join('', (@x,1) x 4), '1231123112311231', '(@x,1) x Y'); 51*0Sstevel@tonic-gateis(join(':', () x 4), '', '() x Y'); 52*0Sstevel@tonic-gateis(join(':', (9) x 4), '9:9:9:9', '(X) x Y'); 53*0Sstevel@tonic-gateis(join(':', (9,9) x 4), '9:9:9:9:9:9:9:9', '(X,X) x Y'); 54*0Sstevel@tonic-gateis(join('', (split(//,"123")) x 2), '123123', 'split and x'); 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateis(join('', @x x -12), '', '@x x -12'); 57*0Sstevel@tonic-gateis(join('', (@x) x -14), '', '(@x) x -14'); 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gate# This test is actually testing for Digital C compiler optimizer bug, 61*0Sstevel@tonic-gate# present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS), 62*0Sstevel@tonic-gate# found in December 1998. The bug was reported to Digital^WCompaq as 63*0Sstevel@tonic-gate# DECC 2745 (21-Dec-1998) 64*0Sstevel@tonic-gate# GEM_BUGS 7619 (23-Dec-1998) 65*0Sstevel@tonic-gate# As of April 1999 the bug has been fixed in Tru64 UNIX 5.0 and is planned 66*0Sstevel@tonic-gate# to be fixed also in 4.0G. 67*0Sstevel@tonic-gate# 68*0Sstevel@tonic-gate# The bug was as follows: broken code was produced for util.c:repeatcpy() 69*0Sstevel@tonic-gate# (a utility function for the 'x' operator) in the case *all* these 70*0Sstevel@tonic-gate# four conditions held: 71*0Sstevel@tonic-gate# 72*0Sstevel@tonic-gate# (1) len == 1 73*0Sstevel@tonic-gate# (2) "from" had the 8th bit on in its single character 74*0Sstevel@tonic-gate# (3) count > 7 (the 'x' count > 16) 75*0Sstevel@tonic-gate# (4) the highest optimization level was used in compilation 76*0Sstevel@tonic-gate# (which is the default when compiling Perl) 77*0Sstevel@tonic-gate# 78*0Sstevel@tonic-gate# The bug looked like this (. being the eight-bit character and ? being \xff): 79*0Sstevel@tonic-gate# 80*0Sstevel@tonic-gate# 16 ................ 81*0Sstevel@tonic-gate# 17 .........???????. 82*0Sstevel@tonic-gate# 18 .........???????.. 83*0Sstevel@tonic-gate# 19 .........???????... 84*0Sstevel@tonic-gate# 20 .........???????.... 85*0Sstevel@tonic-gate# 21 .........???????..... 86*0Sstevel@tonic-gate# 22 .........???????...... 87*0Sstevel@tonic-gate# 23 .........???????....... 88*0Sstevel@tonic-gate# 24 .........???????.??????? 89*0Sstevel@tonic-gate# 25 .........???????.???????. 90*0Sstevel@tonic-gate# 91*0Sstevel@tonic-gate# The bug was triggered in the "if (len == 1)" branch. The fix 92*0Sstevel@tonic-gate# was to introduce a new temporary variable. In diff -u format: 93*0Sstevel@tonic-gate# 94*0Sstevel@tonic-gate# register char *frombase = from; 95*0Sstevel@tonic-gate# 96*0Sstevel@tonic-gate# if (len == 1) { 97*0Sstevel@tonic-gate#- todo = *from; 98*0Sstevel@tonic-gate#+ register char c = *from; 99*0Sstevel@tonic-gate# while (count-- > 0) 100*0Sstevel@tonic-gate#- *to++ = todo; 101*0Sstevel@tonic-gate#+ *to++ = c; 102*0Sstevel@tonic-gate# return; 103*0Sstevel@tonic-gate# } 104*0Sstevel@tonic-gate# 105*0Sstevel@tonic-gate# The bug could also be (obscurely) avoided by changing "from" to 106*0Sstevel@tonic-gate# be an unsigned char pointer. 107*0Sstevel@tonic-gate# 108*0Sstevel@tonic-gate# This obscure bug was not found by the then test suite but instead 109*0Sstevel@tonic-gate# by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00. 110*0Sstevel@tonic-gate# 111*0Sstevel@tonic-gate# jhi@iki.fi 112*0Sstevel@tonic-gate# 113*0Sstevel@tonic-gateis("\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'); 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gate# When we use a list repeat in a scalar context, it behaves like 117*0Sstevel@tonic-gate# a scalar repeat. Make sure that works properly, and doesn't leave 118*0Sstevel@tonic-gate# extraneous values on the stack. 119*0Sstevel@tonic-gate# -- robin@kitsite.com 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gatemy ($x, $y) = scalar ((1,2)x2); 122*0Sstevel@tonic-gateis($x, "22", 'list repeat in scalar context'); 123*0Sstevel@tonic-gateis($y, undef, ' no extra values on stack'); 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate# Make sure the stack doesn't get truncated too much - the left 126*0Sstevel@tonic-gate# operand of the eq binop needs to remain! 127*0Sstevel@tonic-gateis(77, scalar ((1,7)x2), 'stack truncation'); 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate 130*0Sstevel@tonic-gate# perlbug 20011113.110 works in 5.6.1, broken in 5.7.2 131*0Sstevel@tonic-gate{ 132*0Sstevel@tonic-gate my $x= [("foo") x 2]; 133*0Sstevel@tonic-gate is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' ); 134*0Sstevel@tonic-gate} 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gate# [ID 20010809.028] x operator not copying elements in 'for' list? 137*0Sstevel@tonic-gate{ 138*0Sstevel@tonic-gate local $TODO = "x operator not copying elements in 'for' list? [ID 20010809.028]"; 139*0Sstevel@tonic-gate my $x = 'abcd'; 140*0Sstevel@tonic-gate my $y = ''; 141*0Sstevel@tonic-gate for (($x =~ /./g) x 2) { 142*0Sstevel@tonic-gate $y .= chop; 143*0Sstevel@tonic-gate } 144*0Sstevel@tonic-gate is($y, 'abcdabcd'); 145*0Sstevel@tonic-gate} 146*0Sstevel@tonic-gate 147