Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
a5727619 MS |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
8d063cd8 | 7 | |
a5727619 | 8 | require './test.pl'; |
3480a8d2 | 9 | plan(tests => 42); |
8d063cd8 LW |
10 | |
11 | # compile time | |
12 | ||
a5727619 | 13 | is('-' x 5, '-----', 'compile time x'); |
2b573ace JH |
14 | is('-' x 3.1, '---', 'compile time 3.1'); |
15 | is('-' x 3.9, '---', 'compile time 3.9'); | |
a5727619 MS |
16 | is('-' x 1, '-', ' x 1'); |
17 | is('-' x 0, '', ' x 0'); | |
3b8c0df9 AL |
18 | is('-' x -1, '', ' x -1'); |
19 | is('-' x undef, '', ' x undef'); | |
2b573ace JH |
20 | is('-' x "foo", '', ' x "foo"'); |
21 | is('-' x "3rd", '---', ' x "3rd"'); | |
8d063cd8 | 22 | |
a5727619 | 23 | is('ab' x 3, 'ababab', ' more than one char'); |
8d063cd8 LW |
24 | |
25 | # run time | |
26 | ||
27 | $a = '-'; | |
a5727619 | 28 | is($a x 5, '-----', 'run time x'); |
2b573ace JH |
29 | is($a x 3.1, '---', ' x 3.1'); |
30 | is($a x 3.9, '---', ' x 3.9'); | |
a5727619 MS |
31 | is($a x 1, '-', ' x 1'); |
32 | is($a x 0, '', ' x 0'); | |
3b8c0df9 AL |
33 | is($a x -3, '', ' x -3'); |
34 | is($a x undef, '', ' x undef'); | |
2b573ace JH |
35 | is($a x "foo", '', ' x "foo"'); |
36 | is($a x "3rd", '---', ' x "3rd"'); | |
8d063cd8 LW |
37 | |
38 | $a = 'ab'; | |
a5727619 | 39 | is($a x 3, 'ababab', ' more than one char'); |
3b8c0df9 AL |
40 | $a = 'ab'; |
41 | is($a x 0, '', ' more than one char'); | |
42 | $a = 'ab'; | |
43 | is($a x -12, '', ' more than one char'); | |
8d063cd8 LW |
44 | |
45 | $a = 'xyz'; | |
46 | $a x= 2; | |
a5727619 | 47 | is($a, 'xyzxyz', 'x=2'); |
8d063cd8 | 48 | $a x= 1; |
a5727619 | 49 | is($a, 'xyzxyz', 'x=1'); |
8d063cd8 | 50 | $a x= 0; |
a5727619 | 51 | is($a, '', 'x=0'); |
8d063cd8 | 52 | |
fe14fcc3 LW |
53 | @x = (1,2,3); |
54 | ||
a5727619 MS |
55 | is(join('', @x x 4), '3333', '@x x Y'); |
56 | is(join('', (@x) x 4), '123123123123', '(@x) x Y'); | |
57 | is(join('', (@x,()) x 4), '123123123123', '(@x,()) x Y'); | |
58 | is(join('', (@x,1) x 4), '1231123112311231', '(@x,1) x Y'); | |
59 | is(join(':', () x 4), '', '() x Y'); | |
60 | is(join(':', (9) x 4), '9:9:9:9', '(X) x Y'); | |
61 | is(join(':', (9,9) x 4), '9:9:9:9:9:9:9:9', '(X,X) x Y'); | |
62 | is(join('', (split(//,"123")) x 2), '123123', 'split and x'); | |
5926133d | 63 | |
3b8c0df9 AL |
64 | is(join('', @x x -12), '', '@x x -12'); |
65 | is(join('', (@x) x -14), '', '(@x) x -14'); | |
66 | ||
a5727619 MS |
67 | |
68 | # This test is actually testing for Digital C compiler optimizer bug, | |
13476c87 JH |
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 JH |
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 JH |
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 JH |
113 | # The bug could also be (obscurely) avoided by changing "from" to |
114 | # be an unsigned char pointer. | |
115 | # | |
5926133d JH |
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 MS |
121 | 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'); |
122 | ||
b80b6069 RH |
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 | ||
129 | my ($x, $y) = scalar ((1,2)x2); | |
a5727619 MS |
130 | is($x, "22", 'list repeat in scalar context'); |
131 | is($y, undef, ' no extra values on stack'); | |
b80b6069 RH |
132 | |
133 | # Make sure the stack doesn't get truncated too much - the left | |
134 | # operand of the eq binop needs to remain! | |
a5727619 MS |
135 | is(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 JH |
140 | my $x= [("foo") x 2]; |
141 | is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' ); | |
a5727619 | 142 | } |
976c8a39 JH |
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 RGS |
154 | |
155 | # [perl #35885] | |
156 | is( (join ',', (qw(a b c) x 3)), 'a,b,c,a,b,c,a,b,c', 'x on qw produces list' ); |