Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / length.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 print "1..20\n";
9
10 print "not " unless length("")    == 0;
11 print "ok 1\n";
12
13 print "not " unless length("abc") == 3;
14 print "ok 2\n";
15
16 $_ = "foobar";
17 print "not " unless length()      == 6;
18 print "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 {
36     my $a = pack("U", 0xFF);
37
38     print "not " unless length($a) == 1;
39     print "ok 6\n";
40     $test++;
41
42     use bytes;
43     if (ord('A') == 193)
44      {
45       printf "#%vx for 0xFF\n",$a;
46       print "not " unless $a eq "\x8b\x73" && length($a) == 2;
47      }
48     else
49      {
50       print "not " unless $a eq "\xc3\xbf" && length($a) == 2;
51      }
52     print "ok 7\n";
53     $test++;
54 }
55
56 {
57     my $a = "\x{100}";
58
59     print "not " unless length($a) == 1;
60     print "ok 8\n";
61     $test++;
62
63     use bytes;
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      }
73     print "ok 9\n";
74     $test++;
75 }
76
77 {
78     my $a = "\x{100}\x{80}";
79
80     print "not " unless length($a) == 2;
81     print "ok 10\n";
82     $test++;
83
84     use bytes;
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      }
94     print "ok 11\n";
95     $test++;
96 }
97
98 {
99     my $a = "\x{80}\x{100}";
100
101     print "not " unless length($a) == 2;
102     print "ok 12\n";
103     $test++;
104
105     use bytes;
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      }
115     print "ok 13\n";
116     $test++;
117 }
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 }
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 }