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