xref: /openbsd-src/gnu/usr.bin/perl/cpan/autodie/t/utf8_open.t (revision b8851fcc53cbe24fd20b090f26dd149e353f6174)
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