1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Aprint "1..20\n";
1N/A
1N/Aprint "not " unless length("") == 0;
1N/Aprint "ok 1\n";
1N/A
1N/Aprint "not " unless length("abc") == 3;
1N/Aprint "ok 2\n";
1N/A
1N/A$_ = "foobar";
1N/Aprint "not " unless length() == 6;
1N/Aprint "ok 3\n";
1N/A
1N/A# Okay, so that wasn't very challenging. Let's go Unicode.
1N/A
1N/A{
1N/A my $a = "\x{41}";
1N/A
1N/A print "not " unless length($a) == 1;
1N/A print "ok 4\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A print "not " unless $a eq "\x41" && length($a) == 1;
1N/A print "ok 5\n";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A my $a = pack("U", 0xFF);
1N/A
1N/A print "not " unless length($a) == 1;
1N/A print "ok 6\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A if (ord('A') == 193)
1N/A {
1N/A printf "#%vx for 0xFF\n",$a;
1N/A print "not " unless $a eq "\x8b\x73" && length($a) == 2;
1N/A }
1N/A else
1N/A {
1N/A print "not " unless $a eq "\xc3\xbf" && length($a) == 2;
1N/A }
1N/A print "ok 7\n";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A my $a = "\x{100}";
1N/A
1N/A print "not " unless length($a) == 1;
1N/A print "ok 8\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A if (ord('A') == 193)
1N/A {
1N/A printf "#%vx for 0x100\n",$a;
1N/A print "not " unless $a eq "\x8c\x41" && length($a) == 2;
1N/A }
1N/A else
1N/A {
1N/A print "not " unless $a eq "\xc4\x80" && length($a) == 2;
1N/A }
1N/A print "ok 9\n";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A my $a = "\x{100}\x{80}";
1N/A
1N/A print "not " unless length($a) == 2;
1N/A print "ok 10\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A if (ord('A') == 193)
1N/A {
1N/A printf "#%vx for 0x100 0x80\n",$a;
1N/A print "not " unless $a eq "\x8c\x41\x8a\x67" && length($a) == 4;
1N/A }
1N/A else
1N/A {
1N/A print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
1N/A }
1N/A print "ok 11\n";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A my $a = "\x{80}\x{100}";
1N/A
1N/A print "not " unless length($a) == 2;
1N/A print "ok 12\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A if (ord('A') == 193)
1N/A {
1N/A printf "#%vx for 0x80 0x100\n",$a;
1N/A print "not " unless $a eq "\x8a\x67\x8c\x41" && length($a) == 4;
1N/A }
1N/A else
1N/A {
1N/A print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
1N/A }
1N/A print "ok 13\n";
1N/A $test++;
1N/A}
1N/A
1N/A# Now for Unicode with magical vtbls
1N/A
1N/A{
1N/A require Tie::Scalar;
1N/A my $a;
1N/A tie $a, 'Tie::StdScalar'; # makes $a magical
1N/A $a = "\x{263A}";
1N/A
1N/A print "not " unless length($a) == 1;
1N/A print "ok 14\n";
1N/A $test++;
1N/A
1N/A use bytes;
1N/A print "not " unless length($a) == 3;
1N/A print "ok 15\n";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A # Play around with Unicode strings,
1N/A # give a little workout to the UTF-8 length cache.
1N/A my $a = chr(256) x 100;
1N/A print length $a == 100 ? "ok 16\n" : "not ok 16\n";
1N/A chop $a;
1N/A print length $a == 99 ? "ok 17\n" : "not ok 17\n";
1N/A $a .= $a;
1N/A print length $a == 198 ? "ok 18\n" : "not ok 18\n";
1N/A $a = chr(256) x 999;
1N/A print length $a == 999 ? "ok 19\n" : "not ok 19\n";
1N/A substr($a, 0, 1) = '';
1N/A print length $a == 998 ? "ok 20\n" : "not ok 20\n";
1N/A}