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