Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / length.t
CommitLineData
9dc04555 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
54f923ef 8print "1..20\n";
9dc04555 9
10print "not " unless length("") == 0;
11print "ok 1\n";
12
13print "not " unless length("abc") == 3;
14print "ok 2\n";
15
16$_ = "foobar";
17print "not " unless length() == 6;
18print "ok 3\n";
19
20# Okay, so that wasn't very challenging. Let's go Unicode.
21
22{
23 my $a = "\x{41}";
24
25 print "not " unless length($a) == 1;
26 print "ok 4\n";
27 $test++;
28
29 use bytes;
30 print "not " unless $a eq "\x41" && length($a) == 1;
31 print "ok 5\n";
32 $test++;
33}
34
35{
6c8584ec 36 my $a = pack("U", 0xFF);
c4d5f83a 37
9dc04555 38 print "not " unless length($a) == 1;
39 print "ok 6\n";
40 $test++;
c4d5f83a 41
9dc04555 42 use bytes;
c4d5f83a 43 if (ord('A') == 193)
44 {
6c8584ec 45 printf "#%vx for 0xFF\n",$a;
e87322b2 46 print "not " unless $a eq "\x8b\x73" && length($a) == 2;
c4d5f83a 47 }
48 else
49 {
6c8584ec 50 print "not " unless $a eq "\xc3\xbf" && length($a) == 2;
c4d5f83a 51 }
9dc04555 52 print "ok 7\n";
53 $test++;
54}
55
56{
57 my $a = "\x{100}";
c4d5f83a 58
9dc04555 59 print "not " unless length($a) == 1;
60 print "ok 8\n";
61 $test++;
c4d5f83a 62
9dc04555 63 use bytes;
c4d5f83a 64 if (ord('A') == 193)
65 {
66 printf "#%vx for 0x100\n",$a;
67 print "not " unless $a eq "\x8c\x41" && length($a) == 2;
68 }
69 else
70 {
71 print "not " unless $a eq "\xc4\x80" && length($a) == 2;
72 }
9dc04555 73 print "ok 9\n";
74 $test++;
75}
76
77{
78 my $a = "\x{100}\x{80}";
c4d5f83a 79
9dc04555 80 print "not " unless length($a) == 2;
81 print "ok 10\n";
82 $test++;
c4d5f83a 83
9dc04555 84 use bytes;
c4d5f83a 85 if (ord('A') == 193)
86 {
87 printf "#%vx for 0x100 0x80\n",$a;
88 print "not " unless $a eq "\x8c\x41\x8a\x67" && length($a) == 4;
89 }
90 else
91 {
92 print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
93 }
9dc04555 94 print "ok 11\n";
95 $test++;
96}
97
98{
99 my $a = "\x{80}\x{100}";
c4d5f83a 100
9dc04555 101 print "not " unless length($a) == 2;
102 print "ok 12\n";
103 $test++;
c4d5f83a 104
9dc04555 105 use bytes;
c4d5f83a 106 if (ord('A') == 193)
107 {
108 printf "#%vx for 0x80 0x100\n",$a;
109 print "not " unless $a eq "\x8a\x67\x8c\x41" && length($a) == 4;
110 }
111 else
112 {
113 print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
114 }
9dc04555 115 print "ok 13\n";
116 $test++;
117}
5636d518 118
119# Now for Unicode with magical vtbls
120
121{
122 require Tie::Scalar;
123 my $a;
124 tie $a, 'Tie::StdScalar'; # makes $a magical
125 $a = "\x{263A}";
126
127 print "not " unless length($a) == 1;
128 print "ok 14\n";
129 $test++;
130
131 use bytes;
132 print "not " unless length($a) == 3;
133 print "ok 15\n";
134 $test++;
135}
54f923ef 136
137{
138 # Play around with Unicode strings,
139 # give a little workout to the UTF-8 length cache.
140 my $a = chr(256) x 100;
141 print length $a == 100 ? "ok 16\n" : "not ok 16\n";
142 chop $a;
143 print length $a == 99 ? "ok 17\n" : "not ok 17\n";
144 $a .= $a;
145 print length $a == 198 ? "ok 18\n" : "not ok 18\n";
146 $a = chr(256) x 999;
147 print length $a == 999 ? "ok 19\n" : "not ok 19\n";
148 substr($a, 0, 1) = '';
149 print length $a == 998 ? "ok 20\n" : "not ok 20\n";
150}