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