Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / op / length.t
CommitLineData
9dc04555 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
d0644529 5 require './test.pl';
9dc04555 6 @INC = '../lib';
7}
8
9f621bb0 9plan (tests => 28);
9dc04555 10
11print "not " unless length("") == 0;
12print "ok 1\n";
13
14print "not " unless length("abc") == 3;
15print "ok 2\n";
16
17$_ = "foobar";
18print "not " unless length() == 6;
19print "ok 3\n";
20
21# Okay, so that wasn't very challenging. Let's go Unicode.
22
23{
24 my $a = "\x{41}";
25
26 print "not " unless length($a) == 1;
27 print "ok 4\n";
28 $test++;
29
30 use bytes;
31 print "not " unless $a eq "\x41" && length($a) == 1;
32 print "ok 5\n";
33 $test++;
34}
35
36{
6c8584ec 37 my $a = pack("U", 0xFF);
c4d5f83a 38
9dc04555 39 print "not " unless length($a) == 1;
40 print "ok 6\n";
41 $test++;
c4d5f83a 42
9dc04555 43 use bytes;
c4d5f83a 44 if (ord('A') == 193)
45 {
6c8584ec 46 printf "#%vx for 0xFF\n",$a;
e87322b2 47 print "not " unless $a eq "\x8b\x73" && length($a) == 2;
c4d5f83a 48 }
49 else
50 {
6c8584ec 51 print "not " unless $a eq "\xc3\xbf" && length($a) == 2;
c4d5f83a 52 }
9dc04555 53 print "ok 7\n";
54 $test++;
55}
56
57{
58 my $a = "\x{100}";
c4d5f83a 59
9dc04555 60 print "not " unless length($a) == 1;
61 print "ok 8\n";
62 $test++;
c4d5f83a 63
9dc04555 64 use bytes;
c4d5f83a 65 if (ord('A') == 193)
66 {
67 printf "#%vx for 0x100\n",$a;
68 print "not " unless $a eq "\x8c\x41" && length($a) == 2;
69 }
70 else
71 {
72 print "not " unless $a eq "\xc4\x80" && length($a) == 2;
73 }
9dc04555 74 print "ok 9\n";
75 $test++;
76}
77
78{
79 my $a = "\x{100}\x{80}";
c4d5f83a 80
9dc04555 81 print "not " unless length($a) == 2;
82 print "ok 10\n";
83 $test++;
c4d5f83a 84
9dc04555 85 use bytes;
c4d5f83a 86 if (ord('A') == 193)
87 {
88 printf "#%vx for 0x100 0x80\n",$a;
89 print "not " unless $a eq "\x8c\x41\x8a\x67" && length($a) == 4;
90 }
91 else
92 {
93 print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
94 }
9dc04555 95 print "ok 11\n";
96 $test++;
97}
98
99{
100 my $a = "\x{80}\x{100}";
c4d5f83a 101
9dc04555 102 print "not " unless length($a) == 2;
103 print "ok 12\n";
104 $test++;
c4d5f83a 105
9dc04555 106 use bytes;
c4d5f83a 107 if (ord('A') == 193)
108 {
109 printf "#%vx for 0x80 0x100\n",$a;
110 print "not " unless $a eq "\x8a\x67\x8c\x41" && length($a) == 4;
111 }
112 else
113 {
114 print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
115 }
9dc04555 116 print "ok 13\n";
117 $test++;
118}
5636d518 119
120# Now for Unicode with magical vtbls
121
122{
123 require Tie::Scalar;
124 my $a;
125 tie $a, 'Tie::StdScalar'; # makes $a magical
126 $a = "\x{263A}";
127
128 print "not " unless length($a) == 1;
129 print "ok 14\n";
130 $test++;
131
132 use bytes;
133 print "not " unless length($a) == 3;
134 print "ok 15\n";
135 $test++;
136}
54f923ef 137
138{
139 # Play around with Unicode strings,
140 # give a little workout to the UTF-8 length cache.
141 my $a = chr(256) x 100;
142 print length $a == 100 ? "ok 16\n" : "not ok 16\n";
143 chop $a;
144 print length $a == 99 ? "ok 17\n" : "not ok 17\n";
145 $a .= $a;
146 print length $a == 198 ? "ok 18\n" : "not ok 18\n";
147 $a = chr(256) x 999;
148 print length $a == 999 ? "ok 19\n" : "not ok 19\n";
149 substr($a, 0, 1) = '';
150 print length $a == 998 ? "ok 20\n" : "not ok 20\n";
151}
d0644529 152
153curr_test(21);
154
155require Tie::Scalar;
156
157$u = "ASCII";
158
159tie $u, 'Tie::StdScalar', chr 256;
160
161is(length $u, 1, "Length of a UTF-8 scalar returned from tie");
162is(length $u, 1, "Again! Again!");
163
9f621bb0 164$^W = 1;
165
166my $warnings = 0;
167
168$SIG{__WARN__} = sub {
169 $warnings++;
170 warn @_;
171};
172
173is(length(undef), undef, "Length of literal undef");
174
175my $u;
176
177is(length($u), undef, "Length of regular scalar");
178
179$u = "Gotcha!";
180
181tie $u, 'Tie::StdScalar';
182
183is(length($u), undef, "Length of tied scalar (MAGIC)");
184
185is($u, undef);
186
187{
188 package U;
189 use overload '""' => sub {return undef;};
190}
191
192my $uo = bless [], 'U';
193
194is(length($uo), undef, "Length of overloaded reference");
195
196# ok(!defined $uo); Turns you can't test this. FIXME for pp_defined?
197
198is($warnings, 0, "There were no warnings");