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 }