xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/op/length.t (revision 0:68f95e015346) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6}
7
8print "1..20\n";
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{
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}
151