t/io/utf8.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     unless ($Config{'useperlio'}) {
   8         print "1..0 # Skip: not perlio\n";
   9         exit 0;
  10     }
  11 }
  12
  13 $| = 1;
  14 print "1..13\n";
  15
  16 open(F,"+>:utf8",'a');
  17 print F chr(0x100).'£';
  18 print '#'.tell(F)."\n";
  19 print "not " unless tell(F) == 4;
  20 print "ok 1\n";
  21 print F "\n";
  22 print '#'.tell(F)."\n";
  23 print "not " unless tell(F) >= 5;
  24 print "ok 2\n";
  25 seek(F,0,0);
  26 print "not " unless getc(F) eq chr(0x100);
  27 print "ok 3\n";
  28 print "not " unless getc(F) eq "£";
  29 print "ok 4\n";
  30 print "not " unless getc(F) eq "\n";
  31 print "ok 5\n";
  32 seek(F,0,0);
  33 binmode(F,":bytes");
  34 print "not " unless getc(F) eq chr(0xc4);
  35 print "ok 6\n";
  36 print "not " unless getc(F) eq chr(0x80);
  37 print "ok 7\n";
  38 print "not " unless getc(F) eq chr(0xc2);
  39 print "ok 8\n";
  40 print "not " unless getc(F) eq chr(0xa3);
  41 print "ok 9\n";
  42 print "not " unless getc(F) eq "\n";
  43 print "ok 10\n";
  44 seek(F,0,0);
  45 binmode(F,":utf8");
  46 print "not " unless scalar(<F>) eq "\x{100}£\n";
  47 print "ok 11\n";
  48 seek(F,0,0);
  49 $buf = chr(0x200);
  50 $count = read(F,$buf,2,1);
  51 print "not " unless $count == 2;
  52 print "ok 12\n";
  53 print "not " unless $buf eq "\x{200}\x{100}£";
  54 print "ok 13\n";
  55 close(F);
  56
  57 # unlink('a');
  58