diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-08-05 16:10:59 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-08-05 16:10:59 +0000 |
commit | 2b8740d823413f94180ffcaa10364510759dbab1 (patch) | |
tree | fd62735ace66b9ae32f15335fcb97b0033951bcd /ext/PerlIO | |
parent | 108967c2780c6a80477cd84ad2874a41e5d02472 (diff) | |
download | perl-2b8740d823413f94180ffcaa10364510759dbab1.tar.gz |
Add a test for PerlIO::Via.
p4raw-id: //depot/perl@11582
Diffstat (limited to 'ext/PerlIO')
-rw-r--r-- | ext/PerlIO/Via/Via.pm | 9 | ||||
-rw-r--r-- | ext/PerlIO/t/via.t | 33 |
2 files changed, 40 insertions, 2 deletions
diff --git a/ext/PerlIO/Via/Via.pm b/ext/PerlIO/Via/Via.pm index 1f5dedd762..2c7328942a 100644 --- a/ext/PerlIO/Via/Via.pm +++ b/ext/PerlIO/Via/Via.pm @@ -22,8 +22,13 @@ following methods. In the method descriptions below I<$fh> will be a reference to a glob which can be treated as a perl file handle. It refers to the layer below. I<$fh> is not passed if the layer is at the bottom of the stack, for this reason and to maintain -some level of "compatibility" with TIEHANDLE classes it is passed -last. +some level of "compatibility" with TIEHANDLE classes it is passed last. + +As an example, in Perl release 5.8.0 the MIME::QuotedPrint module +defines the required TIEHANDLE methods so that you can say + + use MIME::QuotedPrint; + open(my $fh, ">Via(MIME::QuotedPrint)", "qp"); =over 4 diff --git a/ext/PerlIO/t/via.t b/ext/PerlIO/t/via.t new file mode 100644 index 0000000000..a2201e08c6 --- /dev/null +++ b/ext/PerlIO/t/via.t @@ -0,0 +1,33 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + unless (find PerlIO::Layer 'perlio') { + print "1..0 # Skip: not perlio\n"; + exit 0; + } +} + +my $tmp = "via$$"; + +print "1..3\n"; + +$a = join("", map { chr } 0..255) x 10; + +use MIME::QuotedPrint; +open(my $fh,">Via(MIME::QuotedPrint)", $tmp); +print $fh $a; +close($fh); +print "ok 1\n"; + +open(my $fh,"<Via(MIME::QuotedPrint)", $tmp); +{ local $/; $b = <$fh> } +close($fh); +print "ok 2\n"; + +print "ok 3\n" if $a eq $b; + +END { + 1 while unlink $tmp; +} |