This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove exports of dummy set[ug]id functions on Windows
[perl5.git] / ext / PerlIO-encoding / t / encoding.t
CommitLineData
bb7af5ca 1#!./perl -w
9ba8831b
JH
2
3BEGIN {
9ba8831b
JH
4 unless (find PerlIO::Layer 'perlio') {
5 print "1..0 # Skip: not perlio\n";
6 exit 0;
7 }
54cfe943
RB
8 unless (eval { require Encode } ) {
9 print "1..0 # Skip: not Encode\n";
10 exit 0;
11 }
9ba8831b
JH
12}
13
30029c0d 14use Test::More tests => 18;
08efa405 15
8e86646e
JH
16my $grk = "grk$$";
17my $utf = "utf$$";
92e410c2
MB
18my $fail1 = "fa$$";
19my $fail2 = "fb$$";
ed53a2bb 20my $russki = "koi8r$$";
19d607df 21my $threebyte = "3byte$$";
8e86646e 22
2b18b92a
JH
23if (open(GRK, ">$grk")) {
24 binmode(GRK, ":bytes");
8e86646e
JH
25 # alpha beta gamma in ISO 8859-7
26 print GRK "\xe1\xe2\xe3";
d1e4d418 27 close GRK or die "Could not close: $!";
8e86646e
JH
28}
29
30{
30029c0d
NC
31 is(open(my $i,'<:encoding(iso-8859-7)',$grk), 1);
32 is(open(my $o,'>:utf8',$utf), 1);
33 is((print $o readline $i), 1);
d1e4d418 34 close($o) or die "Could not close: $!";
8e86646e
JH
35 close($i);
36}
37
2b18b92a
JH
38if (open(UTF, "<$utf")) {
39 binmode(UTF, ":bytes");
07229bbd
JH
40 if (ord('A') == 193) { # EBCDIC
41 # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
30029c0d 42 is(scalar <UTF>, "\xb4\x58\xb4\x59\xb4\x62");
07229bbd
JH
43 } else {
44 # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
30029c0d 45 is(scalar <UTF>, "\xce\xb1\xce\xb2\xce\xb3");
07229bbd 46 }
206b12d5 47 close UTF;
8e86646e
JH
48}
49
50{
51 use Encode;
30029c0d
NC
52 is (open(my $i,'<:utf8',$utf), 1);
53 is (open(my $o,'>:encoding(iso-8859-7)',$grk), 1);
54 is ((scalar print $o readline $i), 1);
d1e4d418 55 close($o) or die "Could not close: $!";
8e86646e
JH
56 close($i);
57}
58
2b18b92a
JH
59if (open(GRK, "<$grk")) {
60 binmode(GRK, ":bytes");
30029c0d 61 is(scalar <GRK>, "\xe1\xe2\xe3");
206b12d5 62 close GRK;
8e86646e
JH
63}
64
bb7af5ca 65$SIG{__WARN__} = sub {$warn .= $_[0]};
b26b1ab5 66
30029c0d
NC
67is (open(FAIL, ">:encoding(NoneSuch)", $fail1), undef, 'Open should fail');
68like($warn, qr/^Cannot find encoding "NoneSuch" at/);
69
70is(open(RUSSKI, ">$russki"), 1);
71print RUSSKI "\x3c\x3f\x78";
72close RUSSKI or die "Could not close: $!";
73open(RUSSKI, "$russki");
74binmode(RUSSKI, ":raw");
75my $buf1;
76read(RUSSKI, $buf1, 1);
77# eof(RUSSKI);
78binmode(RUSSKI, ":encoding(koi8-r)");
79my $buf2;
80read(RUSSKI, $buf2, 1);
81my $offset = tell(RUSSKI);
82is(ord $buf1, 0x3c);
83is(ord $buf2, (ord('A') == 193) ? 0x6f : 0x3f);
84is($offset, 2);
85close RUSSKI;
ed53a2bb 86
bb7af5ca
NC
87undef $warn;
88
89# Check there is no Use of uninitialized value in concatenation (.) warning
90# due to the way @latin2iso_num was used to make aliases.
30029c0d
NC
91is(open(FAIL, ">:encoding(latin42)", $fail2), undef, 'Open should fail');
92
93like($warn, qr/^Cannot find encoding "latin42" at.*line \d+\.$/);
bb7af5ca 94
19d607df
NIS
95# Create a string of chars that are 3 bytes in UTF-8
96my $str = "\x{1f80}" x 2048;
97
98# Write them to a file
99open(F,'>:utf8',$threebyte) || die "Cannot open $threebyte:$!";
100print F $str;
101close(F);
102
103# Read file back as UTF-8
104open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
105my $dstr = <F>;
106close(F);
30029c0d 107is($dstr, $str);
19d607df 108
fbadb8fa
GA
109# Try decoding some bad stuff
110open(F,'>:raw',$threebyte) || die "Cannot open $threebyte:$!";
501f55b9
JH
111if (ord('A') == 193) { # EBCDIC
112 print F "foo\x8c\x80\x80\x80bar\n\x80foo\n";
113} else {
114 print F "foo\xF0\x80\x80\x80bar\n\x80foo\n";
115}
fbadb8fa
GA
116close(F);
117
118open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
119$dstr = join(":", <F>);
120close(F);
501f55b9 121if (ord('A') == 193) { # EBCDIC
30029c0d 122 is($dstr, "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n");
501f55b9 123} else {
30029c0d 124 is($dstr, "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n");
501f55b9 125}
fbadb8fa 126
8e86646e 127END {
98a392ec 128 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte);
8e86646e 129}