This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Archive-Tar to CPAN version 2.40
[perl5.git] / cpan / autodie / t / utf8_open.t
CommitLineData
273225d4
CBW
1#!/usr/bin/perl -w
2
3# Test that open still honors the open pragma.
4
5use strict;
6use warnings;
7
8use autodie;
9
10use Fcntl;
11use File::Temp;
273225d4
CBW
12use Test::More;
13
14if( $] < '5.01000' ) {
15 plan skip_all => "autodie does not honor the open pragma before 5.10";
16}
17else {
18 plan "no_plan";
19}
20
21# Test with an open pragma on
22{
23 use open IN => ':encoding(utf8)', OUT => ':utf8';
24
25 # Test the standard handles and all newly opened handles are utf8
26 my $file = File::Temp->new;
27 my $txt = "autodie is MËTÁŁ";
28
29 # open for writing
30 {
31 open my $fh, ">", $file;
32
33 my @layers = PerlIO::get_layers($fh);
34 ok( (grep { $_ eq 'utf8' } @layers), "open write honors open pragma" ) or diag join ", ", @layers;
35
36 print $fh $txt;
37 close $fh;
38 }
39
40 # open for reading, explicit
41 {
42 open my $fh, "<", $file;
43
44 my @layers = PerlIO::get_layers($fh);
45 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open read honors open pragma" ) or diag join ", ", @layers;
46
47 is join("\n", <$fh>), $txt;
48 }
49
50 # open for reading, implicit
51 {
52 open my($fh), $file;
53
54 my @layers = PerlIO::get_layers($fh);
55 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers;
56
57 is join("\n", <$fh>), $txt;
58 }
59
60 # open for read/write
61 {
62 open my $fh, "+>", $file;
63
64 my @layers = PerlIO::get_layers($fh);
65 ok( (grep { $_ eq 'utf8' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers;
66 }
67
68 # open for append
69 {
70 open my $fh, ">>", $file;
71
72 my @layers = PerlIO::get_layers($fh);
73 ok( (grep { $_ eq 'utf8' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers;
74 }
ebf27bc8
CBW
75
76 # raw
77 {
78 open my $fh, ">:raw", $file;
79
80 my @layers = PerlIO::get_layers($fh);
81
82 ok( !(grep { $_ eq 'utf8' } @layers), 'open pragma is not used if raw is specified' ) or diag join ", ", @layers;
83 }
273225d4
CBW
84}
85
86
87# Test without open pragma
88{
89 my $file = File::Temp->new;
90 open my $fh, ">", $file;
91
92 my @layers = PerlIO::get_layers($fh);
93 ok( grep(!/utf8/, @layers), "open pragma remains lexical" ) or diag join ", ", @layers;
94}
95
96
97# sysopen
98{
99 use open IN => ':encoding(utf8)', OUT => ':utf8';
100
101 # Test the standard handles and all newly opened handles are utf8
102 my $file = File::Temp->new;
103 my $txt = "autodie is MËTÁŁ";
104
105 # open for writing only
106 {
dd9a180e 107 sysopen my $fh, $file, O_CREAT|O_TRUNC|O_WRONLY;
273225d4
CBW
108
109 my @layers = PerlIO::get_layers($fh);
110 ok( (grep { $_ eq 'utf8' } @layers), "open write honors open pragma" ) or diag join ", ", @layers;
111
112 print $fh $txt;
113 close $fh;
114 }
115
116 # open for reading only
117 {
118 sysopen my $fh, $file, O_RDONLY;
119
120 my @layers = PerlIO::get_layers($fh);
121 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open read honors open pragma" ) or diag join ", ", @layers;
122
123 is join("\n", <$fh>), $txt;
124 }
125
126 # open for reading and writing
127 {
128 sysopen my $fh, $file, O_RDWR;
129
130 my @layers = PerlIO::get_layers($fh);
131 ok( (grep { $_ eq 'utf8' } @layers), "open read/write honors open write pragma" ) or diag join ", ", @layers;
132
133 is join("\n", <$fh>), $txt;
134 }
135}