This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: comments
[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 use Test::More;
13
14 if( $] < '5.01000' ) {
15     plan skip_all => "autodie does not honor the open pragma before 5.10";
16 }
17 else {
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     }
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     }
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     {
107         sysopen my $fh, $file, O_CREAT|O_TRUNC|O_WRONLY;
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 }