Commit | Line | Data |
---|---|---|
9dc04555 | 1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
d97d4e5f | 8 | print "1..15\n"; |
9dc04555 | 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 | { | |
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; |
46 | print "not " unless $a eq "\x80\x45" && 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 | } |