t/io/utf8.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     unless (defined &perlio::import) {
   7         print "1..0 # Skip: not perlio\n";
   8         exit 0;
   9     }
  10 }
  11
  12 $| = 1;
  13 print "1..25\n";
  14
  15 open(F,"+>:utf8",'a');
  16 print F chr(0x100).'£';
  17 print '#'.tell(F)."\n";
  18 print "not " unless tell(F) == 4;
  19 print "ok 1\n";
  20 print F "\n";
  21 print '#'.tell(F)."\n";
  22 print "not " unless tell(F) >= 5;
  23 print "ok 2\n";
  24 seek(F,0,0);
  25 print "not " unless getc(F) eq chr(0x100);
  26 print "ok 3\n";
  27 print "not " unless getc(F) eq "£";
  28 print "ok 4\n";
  29 print "not " unless getc(F) eq "\n";
  30 print "ok 5\n";
  31 seek(F,0,0);
  32 binmode(F,":bytes");
  33 print "not " unless getc(F) eq chr(0xc4);
  34 print "ok 6\n";
  35 print "not " unless getc(F) eq chr(0x80);
  36 print "ok 7\n";
  37 print "not " unless getc(F) eq chr(0xc2);
  38 print "ok 8\n";
  39 print "not " unless getc(F) eq chr(0xa3);
  40 print "ok 9\n";
  41 print "not " unless getc(F) eq "\n";
  42 print "ok 10\n";
  43 seek(F,0,0);
  44 binmode(F,":utf8");
  45 print "not " unless scalar(<F>) eq "\x{100}£\n";
  46 print "ok 11\n";
  47 seek(F,0,0);
  48 $buf = chr(0x200);
  49 $count = read(F,$buf,2,1);
  50 print "not " unless $count == 2;
  51 print "ok 12\n";
  52 print "not " unless $buf eq "\x{200}\x{100}£";
  53 print "ok 13\n";
  54 close(F);
  55
  56 {
  57 $a = chr(300); # This *is* UTF-encoded
  58 $b = chr(130); # This is not.
  59
  60 open F, ">:utf8", 'a' or die $!;
  61 print F $a,"\n";
  62 close F;
  63
  64 open F, "<:utf8", 'a' or die $!;
  65 $x = <F>;
  66 chomp($x);
  67 print "not " unless $x eq chr(300);
  68 print "ok 14\n";
  69
  70 open F, "a" or die $!; # Not UTF
  71 $x = <F>;
  72 chomp($x);
  73 print "not " unless $x eq chr(196).chr(172);
  74 print "ok 15\n";
  75 close F;
  76
  77 open F, ">:utf8", 'a' or die $!;
  78 binmode(F);  # we write a "\n" and then tell() - avoid CRLF issues.
  79 print F $a;
  80 my $y;
  81 { my $x = tell(F);
  82     { use bytes; $y = length($a);}
  83     print "not " unless $x == $y;
  84     print "ok 16\n";
  85 }
  86
  87 { # Check byte length of $b
  88 use bytes; my $y = length($b);
  89 print "not " unless $y == 1;
  90 print "ok 17\n";
  91 }
  92
  93 print F $b,"\n"; # Don't upgrades $b
  94
  95 { # Check byte length of $b
  96 use bytes; my $y = length($b);
  97 print "not ($y) " unless $y == 1;
  98 print "ok 18\n";
  99 }
 100
 101 { my $x = tell(F);
 102     { use bytes; $y += 3;}
 103     print "not ($x,$y) " unless $x == $y;
 104     print "ok 19\n";
 105 }
 106
 107 close F;
 108
 109 open F, "a" or die $!; # Not UTF
 110 $x = <F>;
 111 chomp($x);
 112 printf "not (%vd) ", $x unless $x eq v196.172.194.130;
 113 print "ok 20\n";
 114
 115 open F, "<:utf8", "a" or die $!;
 116 $x = <F>;
 117 chomp($x);
 118 close F;
 119 printf "not (%vd) ", $x unless $x eq chr(300).chr(130);
 120 print "ok 21\n";
 121
 122 # Now let's make it suffer.
 123 open F, ">", "a" or die $!;
 124 eval { print F $a; };
 125 print "not " unless $@ and $@ =~ /Wide character in print/i;
 126 print "ok 22\n";
 127 }
 128
 129 # Hm. Time to get more evil.
 130 open F, ">:utf8", "a" or die $!;
 131 print F $a;
 132 binmode(F, ":bytes");
 133 print F chr(130)."\n";
 134 close F;
 135
 136 open F, "<", "a" or die $!;
 137 $x = <F>; chomp $x;
 138 print "not " unless $x eq v196.172.130;
 139 print "ok 23\n";
 140
 141 # Right.
 142 open F, ">:utf8", "a" or die $!;
 143 print F $a;
 144 close F;
 145 open F, ">>", "a" or die $!;
 146 print F chr(130)."\n";
 147 close F;
 148
 149 open F, "<", "a" or die $!;
 150 $x = <F>; chomp $x;
 151 print "not " unless $x eq v196.172.130;
 152 print "ok 24\n";
 153
 154 # Now we have a deformed file.
 155 open F, "<:utf8", "a" or die $!;
 156 $x = <F>; chomp $x;
 157 { local $SIG{__WARN__} = sub { print "ok 25\n"; };
 158 eval { sprintf "%vd\n", $x; }
 159 }
 160
 161 unlink('a');
 162