16fb12b70Safresh1#!/usr/bin/perl -w 26fb12b70Safresh1 36fb12b70Safresh1# Test that open still honors the open pragma. 46fb12b70Safresh1 56fb12b70Safresh1use strict; 66fb12b70Safresh1use warnings; 76fb12b70Safresh1 86fb12b70Safresh1use autodie; 96fb12b70Safresh1 106fb12b70Safresh1use Fcntl; 116fb12b70Safresh1use File::Temp; 126fb12b70Safresh1use Test::More; 136fb12b70Safresh1 146fb12b70Safresh1if( $] < '5.01000' ) { 156fb12b70Safresh1 plan skip_all => "autodie does not honor the open pragma before 5.10"; 166fb12b70Safresh1} 176fb12b70Safresh1else { 186fb12b70Safresh1 plan "no_plan"; 196fb12b70Safresh1} 206fb12b70Safresh1 216fb12b70Safresh1# Test with an open pragma on 226fb12b70Safresh1{ 236fb12b70Safresh1 use open IN => ':encoding(utf8)', OUT => ':utf8'; 246fb12b70Safresh1 256fb12b70Safresh1 # Test the standard handles and all newly opened handles are utf8 266fb12b70Safresh1 my $file = File::Temp->new; 276fb12b70Safresh1 my $txt = "autodie is MËTÁŁ"; 286fb12b70Safresh1 296fb12b70Safresh1 # open for writing 306fb12b70Safresh1 { 316fb12b70Safresh1 open my $fh, ">", $file; 326fb12b70Safresh1 336fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 346fb12b70Safresh1 ok( (grep { $_ eq 'utf8' } @layers), "open write honors open pragma" ) or diag join ", ", @layers; 356fb12b70Safresh1 366fb12b70Safresh1 print $fh $txt; 376fb12b70Safresh1 close $fh; 386fb12b70Safresh1 } 396fb12b70Safresh1 406fb12b70Safresh1 # open for reading, explicit 416fb12b70Safresh1 { 426fb12b70Safresh1 open my $fh, "<", $file; 436fb12b70Safresh1 446fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 456fb12b70Safresh1 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open read honors open pragma" ) or diag join ", ", @layers; 466fb12b70Safresh1 476fb12b70Safresh1 is join("\n", <$fh>), $txt; 486fb12b70Safresh1 } 496fb12b70Safresh1 506fb12b70Safresh1 # open for reading, implicit 516fb12b70Safresh1 { 526fb12b70Safresh1 open my($fh), $file; 536fb12b70Safresh1 546fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 556fb12b70Safresh1 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers; 566fb12b70Safresh1 576fb12b70Safresh1 is join("\n", <$fh>), $txt; 586fb12b70Safresh1 } 596fb12b70Safresh1 606fb12b70Safresh1 # open for read/write 616fb12b70Safresh1 { 626fb12b70Safresh1 open my $fh, "+>", $file; 636fb12b70Safresh1 646fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 656fb12b70Safresh1 ok( (grep { $_ eq 'utf8' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers; 666fb12b70Safresh1 } 676fb12b70Safresh1 686fb12b70Safresh1 # open for append 696fb12b70Safresh1 { 706fb12b70Safresh1 open my $fh, ">>", $file; 716fb12b70Safresh1 726fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 736fb12b70Safresh1 ok( (grep { $_ eq 'utf8' } @layers), "open implicit read honors open pragma" ) or diag join ", ", @layers; 746fb12b70Safresh1 } 75*b8851fccSafresh1 76*b8851fccSafresh1 # raw 77*b8851fccSafresh1 { 78*b8851fccSafresh1 open my $fh, ">:raw", $file; 79*b8851fccSafresh1 80*b8851fccSafresh1 my @layers = PerlIO::get_layers($fh); 81*b8851fccSafresh1 82*b8851fccSafresh1 ok( !(grep { $_ eq 'utf8' } @layers), 'open pragma is not used if raw is specified' ) or diag join ", ", @layers; 83*b8851fccSafresh1 } 846fb12b70Safresh1} 856fb12b70Safresh1 866fb12b70Safresh1 876fb12b70Safresh1# Test without open pragma 886fb12b70Safresh1{ 896fb12b70Safresh1 my $file = File::Temp->new; 906fb12b70Safresh1 open my $fh, ">", $file; 916fb12b70Safresh1 926fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 936fb12b70Safresh1 ok( grep(!/utf8/, @layers), "open pragma remains lexical" ) or diag join ", ", @layers; 946fb12b70Safresh1} 956fb12b70Safresh1 966fb12b70Safresh1 976fb12b70Safresh1# sysopen 986fb12b70Safresh1{ 996fb12b70Safresh1 use open IN => ':encoding(utf8)', OUT => ':utf8'; 1006fb12b70Safresh1 1016fb12b70Safresh1 # Test the standard handles and all newly opened handles are utf8 1026fb12b70Safresh1 my $file = File::Temp->new; 1036fb12b70Safresh1 my $txt = "autodie is MËTÁŁ"; 1046fb12b70Safresh1 1056fb12b70Safresh1 # open for writing only 1066fb12b70Safresh1 { 1076fb12b70Safresh1 sysopen my $fh, $file, O_CREAT|O_TRUNC|O_WRONLY; 1086fb12b70Safresh1 1096fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 1106fb12b70Safresh1 ok( (grep { $_ eq 'utf8' } @layers), "open write honors open pragma" ) or diag join ", ", @layers; 1116fb12b70Safresh1 1126fb12b70Safresh1 print $fh $txt; 1136fb12b70Safresh1 close $fh; 1146fb12b70Safresh1 } 1156fb12b70Safresh1 1166fb12b70Safresh1 # open for reading only 1176fb12b70Safresh1 { 1186fb12b70Safresh1 sysopen my $fh, $file, O_RDONLY; 1196fb12b70Safresh1 1206fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 1216fb12b70Safresh1 ok( (grep { $_ eq 'encoding(utf8)' } @layers), "open read honors open pragma" ) or diag join ", ", @layers; 1226fb12b70Safresh1 1236fb12b70Safresh1 is join("\n", <$fh>), $txt; 1246fb12b70Safresh1 } 1256fb12b70Safresh1 1266fb12b70Safresh1 # open for reading and writing 1276fb12b70Safresh1 { 1286fb12b70Safresh1 sysopen my $fh, $file, O_RDWR; 1296fb12b70Safresh1 1306fb12b70Safresh1 my @layers = PerlIO::get_layers($fh); 1316fb12b70Safresh1 ok( (grep { $_ eq 'utf8' } @layers), "open read/write honors open write pragma" ) or diag join ", ", @layers; 1326fb12b70Safresh1 1336fb12b70Safresh1 is join("\n", <$fh>), $txt; 1346fb12b70Safresh1 } 1356fb12b70Safresh1} 136