From a47facf7a19db83dbf78974cdd7962d9ffc76952 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Mon, 9 Feb 2009 17:56:53 +0000 Subject: Move the 4 tests of core PerlIO functionality to t/io. PerlIO::Layer::find is implemented in perlio.c --- MANIFEST | 8 +-- ext/PerlIO/t/PerlIO.t | 136 ------------------------------------------------- ext/PerlIO/t/fail.t | 48 ----------------- ext/PerlIO/t/ioleaks.t | 26 ---------- ext/PerlIO/t/open.t | 42 --------------- t/io/perlio.t | 136 +++++++++++++++++++++++++++++++++++++++++++++++++ t/io/perlio_fail.t | 48 +++++++++++++++++ t/io/perlio_leaks.t | 26 ++++++++++ t/io/perlio_open.t | 42 +++++++++++++++ 9 files changed, 256 insertions(+), 256 deletions(-) delete mode 100644 ext/PerlIO/t/PerlIO.t delete mode 100644 ext/PerlIO/t/fail.t delete mode 100644 ext/PerlIO/t/ioleaks.t delete mode 100644 ext/PerlIO/t/open.t create mode 100644 t/io/perlio.t create mode 100644 t/io/perlio_fail.t create mode 100644 t/io/perlio_leaks.t create mode 100644 t/io/perlio_open.t diff --git a/MANIFEST b/MANIFEST index ba0dbc048b..efbe6e9c5e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -974,10 +974,6 @@ ext/PerlIO/scalar/scalar.pm PerlIO layer for scalars ext/PerlIO/scalar/scalar.xs PerlIO layer for scalars ext/PerlIO/scalar/t/scalar.t See if PerlIO::scalar works ext/PerlIO/scalar/t/scalar_ungetc.t Tests for PerlIO layer for scalars -ext/PerlIO/t/fail.t See if bad layers fail -ext/PerlIO/t/ioleaks.t See if PerlIO layers are leaking -ext/PerlIO/t/open.t See if PerlIO certain special opens work -ext/PerlIO/t/PerlIO.t See if PerlIO works ext/PerlIO/via/hints/aix.pl Hint for PerlIO::via for named architecture ext/PerlIO/via/Makefile.PL PerlIO layer for layers in perl ext/PerlIO/via/t/via.t See if PerlIO::via works @@ -3720,6 +3716,10 @@ t/io/layers.t See if PerlIO layers work t/io/nargv.t See if nested ARGV stuff works t/io/openpid.t See if open works for subprocesses t/io/open.t See if open works +t/io/perlio.t See if PerlIO works +t/io/perlio_fail.t See if bad layers fail +t/io/perlio_leaks.t See if PerlIO layers are leaking +t/io/perlio_open.t See if PerlIO certain special opens work t/io/pipe.t See if secure pipes work t/io/print.t See if print commands work t/io/pvbm.t See if PVBMs break IO commands diff --git a/ext/PerlIO/t/PerlIO.t b/ext/PerlIO/t/PerlIO.t deleted file mode 100644 index 3be0f6af36..0000000000 --- a/ext/PerlIO/t/PerlIO.t +++ /dev/null @@ -1,136 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require Config; import Config; - unless (find PerlIO::Layer 'perlio') { - print "1..0 # Skip: PerlIO not used\n"; - exit 0; - } -} - -use Test::More tests => 37; - -use_ok('PerlIO'); - -my $txt = "txt$$"; -my $bin = "bin$$"; -my $utf = "utf$$"; - -my $txtfh; -my $binfh; -my $utffh; - -ok(open($txtfh, ">:crlf", $txt)); - -ok(open($binfh, ">:raw", $bin)); - -ok(open($utffh, ">:utf8", $utf)); - -print $txtfh "foo\n"; -print $txtfh "bar\n"; - -ok(close($txtfh)); - -print $binfh "foo\n"; -print $binfh "bar\n"; - -ok(close($binfh)); - -print $utffh "foo\x{ff}\n"; -print $utffh "bar\x{abcd}\n"; - -ok(close($utffh)); - -ok(open($txtfh, "<:crlf", $txt)); - -ok(open($binfh, "<:raw", $bin)); - - -ok(open($utffh, "<:utf8", $utf)); - -is(scalar <$txtfh>, "foo\n"); -is(scalar <$txtfh>, "bar\n"); - -is(scalar <$binfh>, "foo\n"); -is(scalar <$binfh>, "bar\n"); - -is(scalar <$utffh>, "foo\x{ff}\n"); -is(scalar <$utffh>, "bar\x{abcd}\n"); - -ok(eof($txtfh));; - -ok(eof($binfh)); - -ok(eof($utffh)); - -ok(close($txtfh)); - -ok(close($binfh)); - -ok(close($utffh)); - -# magic temporary file via 3 arg open with undef -{ - ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); - ok( defined fileno($x), ' fileno' ); - - select $x; - ok( (print "ok\n"), ' print' ); - - select STDOUT; - ok( seek($x,0,0), ' seek' ); - is( scalar <$x>, "ok\n", ' readline' ); - ok( tell($x) >= 3, ' tell' ); - - # test magic temp file over STDOUT - open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; - my $status = open(STDOUT,"+<",undef); - open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; - # report after STDOUT is restored - ok($status, ' re-open STDOUT'); - close OLDOUT; -} - -# in-memory open -{ - my $var; - ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var'); - ok( defined fileno($x), ' fileno' ); - - select $x; - ok( (print "ok\n"), ' print' ); - - select STDOUT; - ok( seek($x,0,0), ' seek' ); - is( scalar <$x>, "ok\n", ' readline' ); - ok( tell($x) >= 3, ' tell' ); - - TODO: { - local $TODO = "broken"; - - # test in-memory open over STDOUT - open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; - #close STDOUT; - my $status = open(STDOUT,">",\$var); - my $error = "$!" unless $status; # remember the error - close STDOUT unless $status; - open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; - print "# $error\n" unless $status; - # report after STDOUT is restored - ok($status, ' open STDOUT into in-memory var'); - - # test in-memory open over STDERR - open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!"; - #close STDERR; - ok( open(STDERR,">",\$var), ' open STDERR into in-memory var'); - open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!"; - } -} - - -END { - 1 while unlink $txt; - 1 while unlink $bin; - 1 while unlink $utf; -} - diff --git a/ext/PerlIO/t/fail.t b/ext/PerlIO/t/fail.t deleted file mode 100644 index 56e3d1d5a5..0000000000 --- a/ext/PerlIO/t/fail.t +++ /dev/null @@ -1,48 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require "../t/test.pl"; - skip_all("No perlio") unless (find PerlIO::Layer 'perlio'); - plan (15); -} - -use warnings 'layer'; -my $warn; -my $file = "fail$$"; -$SIG{__WARN__} = sub { $warn = shift }; - -END { 1 while unlink($file) } - -ok(open(FH,">",$file),"Create works"); -close(FH); -ok(open(FH,"<",$file),"Normal open works"); - -$warn = ''; $! = 0; -ok(!binmode(FH,":-)"),"All punctuation fails binmode"); -print "# $!\n"; -isnt($!,0,"Got errno"); -like($warn,qr/in PerlIO layer/,"Got warning"); - -$warn = ''; $! = 0; -ok(!binmode(FH,":nonesuch"),"Bad package fails binmode"); -print "# $!\n"; -isnt($!,0,"Got errno"); -like($warn,qr/nonesuch/,"Got warning"); -close(FH); - -$warn = ''; $! = 0; -ok(!open(FH,"<:-)",$file),"All punctuation fails open"); -print "# $!\n"; -isnt($!,"","Got errno"); -like($warn,qr/in PerlIO layer/,"Got warning"); - -$warn = ''; $! = 0; -ok(!open(FH,"<:nonesuch",$file),"Bad package fails open"); -print "# $!\n"; -isnt($!,0,"Got errno"); -like($warn,qr/nonesuch/,"Got warning"); - -ok(open(FH,"<",$file),"Normal open (still) works"); -close(FH); diff --git a/ext/PerlIO/t/ioleaks.t b/ext/PerlIO/t/ioleaks.t deleted file mode 100644 index ad76c39e9e..0000000000 --- a/ext/PerlIO/t/ioleaks.t +++ /dev/null @@ -1,26 +0,0 @@ -#!perl -# ioleaks.t - -use strict; -use warnings; -use Test::More 'no_plan'; - -# :unix -> not ok -# :stdio -> not ok -# :perlio -> ok -# :crlf -> ok - -TODO: { - local $TODO = "[perl #56644] PerlIO resource leaks on open() and then :pop in :unix and :stdio"; - foreach my $layer(qw(:unix :stdio :perlio :crlf)){ - my $base_fd = do{ open my $in, '<', $0 or die $!; fileno $in }; - - for(1 .. 3){ - open my $fh, "<$layer", $0 or die $!; - - is fileno($fh), $base_fd, $layer; - binmode $fh, ':pop'; - } - } -} - diff --git a/ext/PerlIO/t/open.t b/ext/PerlIO/t/open.t deleted file mode 100644 index 7d870b9e67..0000000000 --- a/ext/PerlIO/t/open.t +++ /dev/null @@ -1,42 +0,0 @@ -#!./perl - -use strict; -use warnings; - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - unless (find PerlIO::Layer 'perlio') { - print "1..0 # Skip: not perlio\n"; - exit 0; - } - use Config; - unless (" $Config{extensions} " =~ / Fcntl /) { - print "1..0 # Skip: no Fcntl (how did you get this far?)\n"; - exit 0; - } -} - -use Test::More tests => 6; - -use Fcntl qw(:seek); - -{ - ok((open my $fh, "+>", undef), "open my \$fh, '+>', undef"); - print $fh "the right write stuff"; - ok(seek($fh, 0, SEEK_SET), "seek to zero"); - my $data = <$fh>; - is($data, "the right write stuff", "found the right stuff"); -} - -{ - ok((open my $fh, "+<", undef), "open my \$fh, '+<', undef"); - print $fh "the right read stuff"; - ok(seek($fh, 0, SEEK_SET), "seek to zero"); - my $data = <$fh>; - is($data, "the right read stuff", "found the right stuff"); -} - - - - diff --git a/t/io/perlio.t b/t/io/perlio.t new file mode 100644 index 0000000000..3be0f6af36 --- /dev/null +++ b/t/io/perlio.t @@ -0,0 +1,136 @@ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + unless (find PerlIO::Layer 'perlio') { + print "1..0 # Skip: PerlIO not used\n"; + exit 0; + } +} + +use Test::More tests => 37; + +use_ok('PerlIO'); + +my $txt = "txt$$"; +my $bin = "bin$$"; +my $utf = "utf$$"; + +my $txtfh; +my $binfh; +my $utffh; + +ok(open($txtfh, ">:crlf", $txt)); + +ok(open($binfh, ">:raw", $bin)); + +ok(open($utffh, ">:utf8", $utf)); + +print $txtfh "foo\n"; +print $txtfh "bar\n"; + +ok(close($txtfh)); + +print $binfh "foo\n"; +print $binfh "bar\n"; + +ok(close($binfh)); + +print $utffh "foo\x{ff}\n"; +print $utffh "bar\x{abcd}\n"; + +ok(close($utffh)); + +ok(open($txtfh, "<:crlf", $txt)); + +ok(open($binfh, "<:raw", $bin)); + + +ok(open($utffh, "<:utf8", $utf)); + +is(scalar <$txtfh>, "foo\n"); +is(scalar <$txtfh>, "bar\n"); + +is(scalar <$binfh>, "foo\n"); +is(scalar <$binfh>, "bar\n"); + +is(scalar <$utffh>, "foo\x{ff}\n"); +is(scalar <$utffh>, "bar\x{abcd}\n"); + +ok(eof($txtfh));; + +ok(eof($binfh)); + +ok(eof($utffh)); + +ok(close($txtfh)); + +ok(close($binfh)); + +ok(close($utffh)); + +# magic temporary file via 3 arg open with undef +{ + ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); + ok( defined fileno($x), ' fileno' ); + + select $x; + ok( (print "ok\n"), ' print' ); + + select STDOUT; + ok( seek($x,0,0), ' seek' ); + is( scalar <$x>, "ok\n", ' readline' ); + ok( tell($x) >= 3, ' tell' ); + + # test magic temp file over STDOUT + open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; + my $status = open(STDOUT,"+<",undef); + open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; + # report after STDOUT is restored + ok($status, ' re-open STDOUT'); + close OLDOUT; +} + +# in-memory open +{ + my $var; + ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var'); + ok( defined fileno($x), ' fileno' ); + + select $x; + ok( (print "ok\n"), ' print' ); + + select STDOUT; + ok( seek($x,0,0), ' seek' ); + is( scalar <$x>, "ok\n", ' readline' ); + ok( tell($x) >= 3, ' tell' ); + + TODO: { + local $TODO = "broken"; + + # test in-memory open over STDOUT + open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; + #close STDOUT; + my $status = open(STDOUT,">",\$var); + my $error = "$!" unless $status; # remember the error + close STDOUT unless $status; + open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; + print "# $error\n" unless $status; + # report after STDOUT is restored + ok($status, ' open STDOUT into in-memory var'); + + # test in-memory open over STDERR + open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!"; + #close STDERR; + ok( open(STDERR,">",\$var), ' open STDERR into in-memory var'); + open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!"; + } +} + + +END { + 1 while unlink $txt; + 1 while unlink $bin; + 1 while unlink $utf; +} + diff --git a/t/io/perlio_fail.t b/t/io/perlio_fail.t new file mode 100644 index 0000000000..56e3d1d5a5 --- /dev/null +++ b/t/io/perlio_fail.t @@ -0,0 +1,48 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require "../t/test.pl"; + skip_all("No perlio") unless (find PerlIO::Layer 'perlio'); + plan (15); +} + +use warnings 'layer'; +my $warn; +my $file = "fail$$"; +$SIG{__WARN__} = sub { $warn = shift }; + +END { 1 while unlink($file) } + +ok(open(FH,">",$file),"Create works"); +close(FH); +ok(open(FH,"<",$file),"Normal open works"); + +$warn = ''; $! = 0; +ok(!binmode(FH,":-)"),"All punctuation fails binmode"); +print "# $!\n"; +isnt($!,0,"Got errno"); +like($warn,qr/in PerlIO layer/,"Got warning"); + +$warn = ''; $! = 0; +ok(!binmode(FH,":nonesuch"),"Bad package fails binmode"); +print "# $!\n"; +isnt($!,0,"Got errno"); +like($warn,qr/nonesuch/,"Got warning"); +close(FH); + +$warn = ''; $! = 0; +ok(!open(FH,"<:-)",$file),"All punctuation fails open"); +print "# $!\n"; +isnt($!,"","Got errno"); +like($warn,qr/in PerlIO layer/,"Got warning"); + +$warn = ''; $! = 0; +ok(!open(FH,"<:nonesuch",$file),"Bad package fails open"); +print "# $!\n"; +isnt($!,0,"Got errno"); +like($warn,qr/nonesuch/,"Got warning"); + +ok(open(FH,"<",$file),"Normal open (still) works"); +close(FH); diff --git a/t/io/perlio_leaks.t b/t/io/perlio_leaks.t new file mode 100644 index 0000000000..ad76c39e9e --- /dev/null +++ b/t/io/perlio_leaks.t @@ -0,0 +1,26 @@ +#!perl +# ioleaks.t + +use strict; +use warnings; +use Test::More 'no_plan'; + +# :unix -> not ok +# :stdio -> not ok +# :perlio -> ok +# :crlf -> ok + +TODO: { + local $TODO = "[perl #56644] PerlIO resource leaks on open() and then :pop in :unix and :stdio"; + foreach my $layer(qw(:unix :stdio :perlio :crlf)){ + my $base_fd = do{ open my $in, '<', $0 or die $!; fileno $in }; + + for(1 .. 3){ + open my $fh, "<$layer", $0 or die $!; + + is fileno($fh), $base_fd, $layer; + binmode $fh, ':pop'; + } + } +} + diff --git a/t/io/perlio_open.t b/t/io/perlio_open.t new file mode 100644 index 0000000000..7d870b9e67 --- /dev/null +++ b/t/io/perlio_open.t @@ -0,0 +1,42 @@ +#!./perl + +use strict; +use warnings; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + unless (find PerlIO::Layer 'perlio') { + print "1..0 # Skip: not perlio\n"; + exit 0; + } + use Config; + unless (" $Config{extensions} " =~ / Fcntl /) { + print "1..0 # Skip: no Fcntl (how did you get this far?)\n"; + exit 0; + } +} + +use Test::More tests => 6; + +use Fcntl qw(:seek); + +{ + ok((open my $fh, "+>", undef), "open my \$fh, '+>', undef"); + print $fh "the right write stuff"; + ok(seek($fh, 0, SEEK_SET), "seek to zero"); + my $data = <$fh>; + is($data, "the right write stuff", "found the right stuff"); +} + +{ + ok((open my $fh, "+<", undef), "open my \$fh, '+<', undef"); + print $fh "the right read stuff"; + ok(seek($fh, 0, SEEK_SET), "seek to zero"); + my $data = <$fh>; + is($data, "the right read stuff", "found the right stuff"); +} + + + + -- cgit v1.2.1