Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.git] / t / op / repeat.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 require './test.pl';
9 plan(tests => 25);
10
11 # compile time
12
13 is('-' x 5, '-----',    'compile time x');
14 is('-' x 1, '-',        '  x 1');
15 is('-' x 0, '',         '  x 0');
16
17 is('ab' x 3, 'ababab',  '  more than one char');
18
19 # run time
20
21 $a = '-';
22 is($a x 5, '-----',     'run time x');
23 is($a x 1, '-',         '  x 1');
24 is($a x 0, '',          '  x 0');
25
26 $a = 'ab';
27 is($a x 3, 'ababab',    '  more than one char');
28
29 $a = 'xyz';
30 $a x= 2;
31 is($a, 'xyzxyz',        'x=2');
32 $a x= 1;
33 is($a, 'xyzxyz',        'x=1');
34 $a x= 0;
35 is($a, '',              'x=0');
36
37 @x = (1,2,3);
38
39 is(join('', @x x 4),        '3333',                 '@x x Y');
40 is(join('', (@x) x 4),      '123123123123',         '(@x) x Y');
41 is(join('', (@x,()) x 4),   '123123123123',         '(@x,()) x Y');
42 is(join('', (@x,1) x 4),    '1231123112311231',     '(@x,1) x Y');
43 is(join(':', () x 4),       '',                     '() x Y');
44 is(join(':', (9) x 4),      '9:9:9:9',              '(X) x Y');
45 is(join(':', (9,9) x 4),    '9:9:9:9:9:9:9:9',      '(X,X) x Y');
46 is(join('', (split(//,"123")) x 2), '123123',       'split and x');
47
48
49 # This test is actually testing for Digital C compiler optimizer bug,
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.
56 #
57 # The bug was as follows: broken code was produced for util.c:repeatcpy()
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 #
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 #
94 # The bug could also be (obscurely) avoided by changing "from" to
95 # be an unsigned char pointer.
96 #
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 #
102 is("\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
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
110 my ($x, $y) = scalar ((1,2)x2);
111 is($x, "22",    'list repeat in scalar context');
112 is($y, undef,   '  no extra values on stack');
113
114 # Make sure the stack doesn't get truncated too much - the left
115 # operand of the eq binop needs to remain!
116 is(77, scalar ((1,7)x2),    'stack truncation');
117
118
119 # perlbug 20011113.110 works in 5.6.1, broken in 5.7.2
120 {
121     my $x= [("foo") x 2];
122     is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' );
123 }
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