From: chromatic Date: Fri, 28 Sep 2001 17:39:50 +0000 (-0600) Subject: Add tests for open.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8c9ad1b2aea45573ad656f23dcb17204fe59851;p=p5sagit%2Fp5-mst-13.2.git Add tests for open.pm Message-ID: <20010928234521.14178.qmail@onion.perl.org> p4raw-id: //depot/perl@12263 --- diff --git a/MANIFEST b/MANIFEST index 9caa039..8d1c8a0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1100,6 +1100,7 @@ lib/NEXT/Changes NEXT lib/NEXT/README NEXT lib/NEXT/test.pl See if NEXT works lib/open.pm Pragma to specify default I/O disciplines +lib/open.t See if the open pragma works lib/open2.pl Open a two-ended pipe (uses IPC::Open2) lib/open3.pl Open a three-ended pipe (uses IPC::Open3) lib/overload.pm Module for overloading perl operators diff --git a/lib/open.t b/lib/open.t new file mode 100644 index 0000000..90e5e3b --- /dev/null +++ b/lib/open.t @@ -0,0 +1,68 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Test::More tests => 12; + +# open::import expects 'open' as its first argument, but it clashes with open() +sub import { + open::import( 'open', @_ ); +} + +# can't use require_ok() here, with a name like 'open' +ok( require 'open.pm', 'required okay!' ); + +# this should fail +eval { import() }; +like( $@, qr/needs explicit list of disciplines/, 'import fails without args' ); + +# the hint bits shouldn't be set yet +is( $^H & $open::hint_bits, 0, '$^H is okay before open import runs' ); + +# prevent it from loading I18N::Langinfo, so we can test encoding failures +local @INC; +$ENV{LC_ALL} = ''; +eval { import( 'IN', 'locale' ) }; +like( $@, qr/Cannot figure out an encoding/, 'no encoding found' ); + +my $warn; +local $SIG{__WARN__} = sub { + $warn .= shift; +}; + +# and it shouldn't be able to find this discipline +eval{ import( 'IN', 'macguffin' ) }; +like( $warn, qr/Unknown discipline layer/, 'warned about unknown discipline' ); + +# now load a real-looking locale +$ENV{LC_ALL} = ' .utf8'; +import( 'IN', 'locale' ); +is( ${^OPEN}, ':utf8\0', 'set locale layer okay!' ); + +# and see if it sets the magic variables appropriately +import( 'IN', ':crlf' ); +ok( $^H & $open::hint_bits, '$^H is set after open import runs' ); +is( $^H{'open_IN'}, 'crlf', 'set crlf layer okay!' ); + +# it should reset them appropriately, too +import( 'IN', ':raw' ); +is( $^H{'open_IN'}, 'raw', 'set raw layer okay!' ); + +# it dies if you don't set IN, OUT, or INOUT +eval { import( 'sideways', ':raw' ) }; +like( $@, qr/Unknown discipline class/, 'croaked with unknown class' ); + +# but it handles them all so well together +import( 'INOUT', ':raw :crlf' ); +is( ${^OPEN}, ':raw :crlf\0:raw :crlf', 'multi types, multi disciplines' ); +is( $^H{'open_INOUT'}, 'crlf', 'last layer set in %^H' ); + +__END__ +# this one won't run as $locale_encoding is already set +# perhaps qx{} it, if it's important to run +$ENV{LC_ALL} = 'nonexistent.euc'; +eval { open::_get_locale_encoding() }; +like( $@, qr/too ambiguous/, 'died with ambiguous locale encoding' );