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