1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc( '../lib' ); 7} 8 9plan(tests => 50); 10 11# compile time 12 13is('-' x 5, '-----', 'compile time x'); 14is('-' x 3.1, '---', 'compile time 3.1'); 15is('-' x 3.9, '---', 'compile time 3.9'); 16is('-' x 1, '-', ' x 1'); 17is('-' x 0, '', ' x 0'); 18is('-' x -1, '', ' x -1'); 19is('-' x undef, '', ' x undef'); 20is('-' x "foo", '', ' x "foo"'); 21is('-' x "3rd", '---', ' x "3rd"'); 22 23is('ab' x 3, 'ababab', ' more than one char'); 24 25# run time 26 27$a = '-'; 28is($a x 5, '-----', 'run time x'); 29is($a x 3.1, '---', ' x 3.1'); 30is($a x 3.9, '---', ' x 3.9'); 31is($a x 1, '-', ' x 1'); 32is($a x 0, '', ' x 0'); 33is($a x -3, '', ' x -3'); 34is($a x undef, '', ' x undef'); 35is($a x "foo", '', ' x "foo"'); 36is($a x "3rd", '---', ' x "3rd"'); 37 38$a = 'ab'; 39is($a x 3, 'ababab', ' more than one char'); 40$a = 'ab'; 41is($a x 0, '', ' more than one char'); 42$a = 'ab'; 43is($a x -12, '', ' more than one char'); 44 45$a = 'xyz'; 46$a x= 2; 47is($a, 'xyzxyz', 'x=2'); 48$a x= 1; 49is($a, 'xyzxyz', 'x=1'); 50$a x= 0; 51is($a, '', 'x=0'); 52 53@x = (1,2,3); 54 55is(join('', @x x 4), '3333', '@x x Y'); 56is(join('', (@x) x 4), '123123123123', '(@x) x Y'); 57is(join('', (@x,()) x 4), '123123123123', '(@x,()) x Y'); 58is(join('', (@x,1) x 4), '1231123112311231', '(@x,1) x Y'); 59is(join(':', () x 4), '', '() x Y'); 60is(join(':', (9) x 4), '9:9:9:9', '(X) x Y'); 61is(join(':', (9,9) x 4), '9:9:9:9:9:9:9:9', '(X,X) x Y'); 62is(join('', (split(//,"123")) x 2), '123123', 'split and x'); 63 64is(join('', @x x -12), '', '@x x -12'); 65is(join('', (@x) x -14), '', '(@x) x -14'); 66 67($a, (undef)x5, $b) = 1..10; 68is ("$a $b", "1 7", '(undef)xCONST on lhs of list assignment'); 69(($a)x3,$b) = 1..10; 70is ("$a, $b", "3, 4", '($x)xCONST on lhs of list assignment'); 71($a, (undef)x${\6}, $b) = "a".."z"; 72is ("$a$b", "ah", '(undef)x$foo on lhs of list assignment'); 73 74 75# This test is actually testing for Digital C compiler optimizer bug, 76# present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS), 77# found in December 1998. The bug was reported to Digital^WCompaq as 78# DECC 2745 (21-Dec-1998) 79# GEM_BUGS 7619 (23-Dec-1998) 80# As of April 1999 the bug has been fixed in Tru64 UNIX 5.0 and is planned 81# to be fixed also in 4.0G. 82# 83# The bug was as follows: broken code was produced for util.c:repeatcpy() 84# (a utility function for the 'x' operator) in the case *all* these 85# four conditions held: 86# 87# (1) len == 1 88# (2) "from" had the 8th bit on in its single character 89# (3) count > 7 (the 'x' count > 16) 90# (4) the highest optimization level was used in compilation 91# (which is the default when compiling Perl) 92# 93# The bug looked like this (. being the eight-bit character and ? being \xff): 94# 95# 16 ................ 96# 17 .........???????. 97# 18 .........???????.. 98# 19 .........???????... 99# 20 .........???????.... 100# 21 .........???????..... 101# 22 .........???????...... 102# 23 .........???????....... 103# 24 .........???????.??????? 104# 25 .........???????.???????. 105# 106# The bug was triggered in the "if (len == 1)" branch. The fix 107# was to introduce a new temporary variable. In diff -u format: 108# 109# register char *frombase = from; 110# 111# if (len == 1) { 112#- todo = *from; 113#+ register char c = *from; 114# while (count-- > 0) 115#- *to++ = todo; 116#+ *to++ = c; 117# return; 118# } 119# 120# The bug could also be (obscurely) avoided by changing "from" to 121# be an unsigned char pointer. 122# 123# This obscure bug was not found by the then test suite but instead 124# by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00. 125# 126# jhi@iki.fi 127# 128is("\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'); 129 130 131# When we use a list repeat in a scalar context, it behaves like 132# a scalar repeat. Make sure that works properly, and doesn't leave 133# extraneous values on the stack. 134# -- robin@kitsite.com 135 136my ($x, $y) = scalar ((1,2)x2); 137is($x, "22", 'list repeat in scalar context'); 138is($y, undef, ' no extra values on stack'); 139 140# Make sure the stack doesn't get truncated too much - the first 141# argument to is() needs to remain! 142is(77, scalar ((1,7)x2), 'stack truncation'); 143 144# ( )x in void context should not read preceding stack items 145package Tiecount { 146 sub TIESCALAR { bless[]} sub FETCH { our $Tiecount++; study; 3 } 147} 148sub nil {} 149tie my $t, "Tiecount"; 150{ push my @temp, $t, scalar((nil) x 3, 1) } 151is($Tiecount::Tiecount, 1, 152 '(...)x... in void context in list (via scalar comma)'); 153 154 155# perlbug 20011113.110 (#7902) works in 5.6.1, broken in 5.7.2 156{ 157 my $x= [("foo") x 2]; 158 is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110 (#7902)]' ); 159} 160 161# [perl #35885] 162is( (join ',', (qw(a b c) x 3)), 'a,b,c,a,b,c,a,b,c', 'x on qw produces list' ); 163 164# [perl #78194] x aliasing op return values 165sub { 166 is(\$_[0], \$_[1], 167 '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by x') 168} 169 ->(("${\''}")x2); 170 171$#that_array = 7; 172for(($#that_array)x2) { 173 $_ *= 2; 174} 175is($#that_array, 28, 'list repetition propagates lvalue cx to its lhs'); 176 177# [perl #126309] huge list counts should give an error 178 179 180fresh_perl_like( 181 '@a = (1) x ~1', 182 qr/Out of memory/, 183 { }, 184 '(1) x ~1', 185); 186 187# [perl #130247] Perl_rpeep(OP *): Assertion `oldop' failed 188# 189# the 'x 0' optimising code in rpeep didn't expect the repeat expression 190# to occur on the op_other side of an op_next chain. 191# This used to give an assertion failure 192 193eval q{() = (() or ((0) x 0)); 1}; 194is($@, "", "RT #130247"); 195 196# yes, the newlines matter 197fresh_perl_is(<<'PERL', "", { stderr => 1 }, "(perl #133778) MARK mishandling"); 198map{s[][];eval;0}<DATA>__END__ 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248()x0 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 2750 276PERL 277