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