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