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