diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/filetest.t | 51 | ||||
| -rw-r--r-- | t/lib/1_compile.t | 1 |
3 files changed, 53 insertions, 0 deletions
@@ -940,6 +940,7 @@ lib/FileCache.t See if FileCache works lib/FileHandle.pm Backward-compatible front end to IO extension lib/FileHandle.t See if FileHandle works lib/filetest.pm For "use filetest" +lib/filetest.t See if filetest works lib/Filter/Simple.pm Simple frontend to Filter::Util::Call lib/Filter/Simple/Changes Filter::Simple lib/Filter/Simple/README Filter::Simple diff --git a/lib/filetest.t b/lib/filetest.t new file mode 100644 index 0000000000..096031c63d --- /dev/null +++ b/lib/filetest.t @@ -0,0 +1,51 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Test::More tests => 11; + +# these two should be kept in sync with the pragma itself +# if hint bits are changed there, other things *will* break +my $hint_bits = 0x00400000; +my $error = "filetest: the only implemented subpragma is 'access'.\n"; + +# can't use it yet, because of the import death +ok( require filetest, 'required pragma successfully' ); + +# and here's one culprit, right here +eval { filetest->import('bad subpragma') }; +is( $@, $error, 'filetest dies with bad subpragma on import' ); + +is( $^H & $hint_bits, 0, 'hint bits not set without pragma in place' ); + +# now try the normal usage +# can't check $^H here; it's lexically magic (see perlvar) +# the test harness unintentionally hoards the goodies for itself +use_ok( 'filetest', 'access' ); + +# and import again, to see it here +filetest->import('access'); +ok( $^H & $hint_bits, 'hint bits set with pragma loaded' ); + +# and now get rid of it +filetest->unimport('access'); +is( $^H & $hint_bits, 0, 'hint bits not set with pragma unimported' ); + +eval { filetest->unimport() }; +is( $@, $error, 'filetest dies without subpragma on unimport' ); + +# there'll be a compilation aborted failure here, with the eval string +eval "no filetest 'fake pragma'"; +like( $@, qr/^$error/, 'filetest dies with bad subpragma on unuse' ); + +eval "use filetest 'bad subpragma'"; +like( $@, qr/^$error/, 'filetest dies with bad subpragma on use' ); + +eval "use filetest"; +like( $@, qr/^$error/, 'filetest dies with missing subpragma on use' ); + +eval "no filetest"; +like( $@, qr/^$error/, 'filetest dies with missing subpragma on unuse' ); diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t index 1d3daa5a4c..22b32e8b90 100644 --- a/t/lib/1_compile.t +++ b/t/lib/1_compile.t @@ -196,4 +196,5 @@ UNIVERSAL attributes base bytes +filetest ops |