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'; |
976c8a39 | 9 | plan(tests => 25); |
8d063cd8 LW |
10 | |
11 | # compile time | |
12 | ||
a5727619 MS |
13 | is('-' x 5, '-----', 'compile time x'); |
14 | is('-' x 1, '-', ' x 1'); | |
15 | is('-' x 0, '', ' x 0'); | |
8d063cd8 | 16 | |
a5727619 | 17 | is('ab' x 3, 'ababab', ' more than one char'); |
8d063cd8 LW |
18 | |
19 | # run time | |
20 | ||
21 | $a = '-'; | |
a5727619 MS |
22 | is($a x 5, '-----', 'run time x'); |
23 | is($a x 1, '-', ' x 1'); | |
24 | is($a x 0, '', ' x 0'); | |
8d063cd8 LW |
25 | |
26 | $a = 'ab'; | |
a5727619 | 27 | is($a x 3, 'ababab', ' more than one char'); |
8d063cd8 LW |
28 | |
29 | $a = 'xyz'; | |
30 | $a x= 2; | |
a5727619 | 31 | is($a, 'xyzxyz', 'x=2'); |
8d063cd8 | 32 | $a x= 1; |
a5727619 | 33 | is($a, 'xyzxyz', 'x=1'); |
8d063cd8 | 34 | $a x= 0; |
a5727619 | 35 | is($a, '', 'x=0'); |
8d063cd8 | 36 | |
fe14fcc3 LW |
37 | @x = (1,2,3); |
38 | ||
a5727619 MS |
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'); | |
5926133d | 47 | |
a5727619 MS |
48 | |
49 | # This test is actually testing for Digital C compiler optimizer bug, | |
13476c87 JH |
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 JH |
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 JH |
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 JH |
94 | # The bug could also be (obscurely) avoided by changing "from" to |
95 | # be an unsigned char pointer. | |
96 | # | |
5926133d JH |
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 MS |
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 | ||
b80b6069 RH |
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); | |
a5727619 MS |
111 | is($x, "22", 'list repeat in scalar context'); |
112 | is($y, undef, ' no extra values on stack'); | |
b80b6069 RH |
113 | |
114 | # Make sure the stack doesn't get truncated too much - the left | |
115 | # operand of the eq binop needs to remain! | |
a5727619 MS |
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 | { | |
976c8a39 JH |
121 | my $x= [("foo") x 2]; |
122 | is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' ); | |
a5727619 | 123 | } |
976c8a39 JH |
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 |