This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / 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..25\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 {
58 $a = chr(300); # This *is* UTF-encoded
59 $b = chr(130); # This is not.
60
61 open F, ">:utf8", 'a' or die $!;
62 print F $a,"\n";
63 close F;
64
65 open F, "<:utf8", 'a' or die $!;
66 $x = <F>;
67 chomp($x);
68 print "not " unless $x eq chr(300);
69 print "ok 14\n";
70
71 open F, "a" or die $!; # Not UTF
72 $x = <F>;
73 chomp($x);
74 print "not " unless $x eq chr(196).chr(172);
75 print "ok 15\n";
76 close F;
77
78 open F, ">:utf8", 'a' or die $!;
79
80 print F $a;
81 my $y;
82 { my $x = tell(F); 
83     { use bytes; $y = length($a);}
84     print "not " unless $x == $y;
85     print "ok 16\n";
86 }
87
88 { # Check byte length of $b
89 use bytes; my $y = length($b);
90 print "not " unless $y == 1;
91 print "ok 17\n";
92 }
93
94 print F $b,"\n"; # This upgrades $b!
95
96 { # Check byte length of $b
97 use bytes; my $y = length($b);
98 print "not " unless $y == 2;
99 print "ok 18\n";
100 }
101
102 { my $x = tell(F); 
103     { use bytes; $y += 3;}
104     print "not " unless $x == $y;
105     print "ok 19\n";
106 }
107
108 close F;
109
110 open F, "a" or die $!; # Not UTF
111 $x = <F>;
112 chomp($x);
113 print "not " unless $x eq v196.172.194.130;
114 print "ok 20\n";
115
116 open F, "<:utf8", "a" or die $!;
117 $x = <F>;
118 chomp($x);
119 close F;
120 print "not " unless $x eq chr(300).chr(130);
121 print "ok 21\n";
122
123 # Now let's make it suffer.
124 open F, ">", "a" or die $!;
125 eval { print F $a; };
126 print "not " unless $@ and $@ =~ /Wide character in print/i;
127 print "ok 22\n";
128 }
129
130 # Hm. Time to get more evil.
131 open F, ">:utf8", "a" or die $!;
132 print F $a;
133 binmode(F, ":bytes");
134 print F chr(130)."\n";
135 close F;
136
137 open F, "<", "a" or die $!;
138 $x = <F>; chomp $x;
139 print "not " unless $x eq v196.172.130;
140 print "ok 23\n";
141
142 # Right.
143 open F, ">:utf8", "a" or die $!;
144 print F $a;
145 close F;
146 open F, ">>", "a" or die $!;
147 print F chr(130)."\n";
148 close F;
149
150 open F, "<", "a" or die $!;
151 $x = <F>; chomp $x;
152 print "not " unless $x eq v196.172.130;
153 print "ok 24\n";
154
155 # Now we have a deformed file.
156 open F, "<:utf8", "a" or die $!;
157 $x = <F>; chomp $x;
158 { local $SIG{__WARN__} = sub { print "ok 25\n"; };
159 eval { sprintf "%vd\n", $x; }
160 }
161
162 unlink('a');
163