diff options
author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2014-02-06 22:09:40 +0000 |
---|---|---|
committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2014-02-06 22:09:40 +0000 |
commit | 3621e4956cb037811317b0195d3248108c6658c3 (patch) | |
tree | 3b72d0c777a6299cb8e96bfdc856487b7358f605 | |
download | Module-Runtime-tarball-master.tar.gz |
Module-Runtime-0.014HEADModule-Runtime-0.014master
-rw-r--r-- | .gitignore | 11 | ||||
-rw-r--r-- | Build.PL | 38 | ||||
-rw-r--r-- | Changes | 180 | ||||
-rw-r--r-- | MANIFEST | 30 | ||||
-rw-r--r-- | META.json | 56 | ||||
-rw-r--r-- | META.yml | 32 | ||||
-rw-r--r-- | Makefile.PL | 35 | ||||
-rw-r--r-- | README | 44 | ||||
-rw-r--r-- | SIGNATURE | 52 | ||||
-rw-r--r-- | lib/Module/Runtime.pm | 505 | ||||
-rw-r--r-- | t/Break.pm | 7 | ||||
-rw-r--r-- | t/Context.pm | 12 | ||||
-rw-r--r-- | t/Eval.pm | 41 | ||||
-rw-r--r-- | t/Hints.pm | 17 | ||||
-rw-r--r-- | t/Nest0.pm | 10 | ||||
-rw-r--r-- | t/Nest1.pm | 12 | ||||
-rw-r--r-- | t/Simple.pm | 9 | ||||
-rw-r--r-- | t/cmn.t | 25 | ||||
-rw-r--r-- | t/dependency.t | 11 | ||||
-rw-r--r-- | t/import_error.t | 35 | ||||
-rw-r--r-- | t/ivmn.t | 49 | ||||
-rw-r--r-- | t/ivms.t | 82 | ||||
-rw-r--r-- | t/mnf.t | 13 | ||||
-rw-r--r-- | t/pod_cvg.t | 9 | ||||
-rw-r--r-- | t/pod_syn.t | 8 | ||||
-rw-r--r-- | t/rm.t | 86 | ||||
-rw-r--r-- | t/taint.t | 24 | ||||
-rw-r--r-- | t/um.t | 111 | ||||
-rw-r--r-- | t/upo.t | 120 | ||||
-rw-r--r-- | t/upo_overridden.t | 19 |
30 files changed, 1683 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3e9a010 --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +/Build +/Makefile +/_build +/blib +/META.json +/META.yml +/MYMETA.json +/MYMETA.yml +/Makefile.PL +/SIGNATURE +/Module-Runtime-* diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..2fb1f4b --- /dev/null +++ b/Build.PL @@ -0,0 +1,38 @@ +{ use 5.006; } +use warnings; +use strict; + +use Module::Build; + +Module::Build->new( + module_name => "Module::Runtime", + license => "perl", + configure_requires => { + "Module::Build" => 0, + "perl" => "5.006", + "strict" => 0, + "warnings" => 0, + }, + build_requires => { + "Module::Build" => 0, + "Test::More" => 0, + "perl" => "5.006", + "strict" => 0, + "warnings" => 0, + }, + requires => { + "perl" => "5.006", + }, + dynamic_config => 0, + meta_add => { distribution_type => "module" }, + meta_merge => { + resources => { + repository => + "git://git.fysh.org/zefram/Module-Runtime.git", + }, + }, + create_makefile_pl => "passthrough", + sign => 1, +)->create_build_script; + +1; @@ -0,0 +1,180 @@ +version 0.014; 2014-02-06 + + * bugfix: suppress any CORE::GLOBAL::require override, where possible, + to avoid use_package_optimistically() being misled into treating + missing modules as broken + + * bugfix: in use_module() and use_package_optimistically(), pass a + supplied VERSION parameter through for the version check even if it + is undef + + * tighten use_package_optimistically()'s recognition of can't-locate + errors (the same way that base.pm has recently been tightened), + so that, when a module fails to load because a module that it uses + isn't available, the outer module will be perceived as broken rather + than missing + + * update documentation notes about the state of Unicode handling for + module names + + * in META.{yml,json}, point to public git repository + +version 0.013; 2012-02-16 + + * fix false failure of the test for lack of unintended dependencies + that occurred on systems using a sitecustomize.pl + +version 0.012; 2012-02-12 + + * work around Perl core bug [perl #68590] regarding leakage of %^H + into modules being loaded + + * work around Perl core bug that made a failed module loading appear + successful when re-requiring the same module + + * duplicate is_string() from Params::Classify, rather than importing it, + to avoid circular dependency problems (affecting both installation + and runtime) + + * duplicate minimal exporting behaviour from Exporter, and avoid using + the "feature", "warnings", "strict", and "parent" pragmata, to allow + for possible future use of this module by any infrastructure module + + * document core bug workarounds + + * document module name syntax more prominently, and discuss the state + of Unicode handling + + * tweak documentation of use_package_optimistically() + + * test behaviour with tainted module name + + * test lack of unwanted eval frame around require + + * give test modules more meaningful names + + * convert .cvsignore to .gitignore + +version 0.011; 2011-10-24 + + * bugfix: in require_module() and use_module(), work around a Perl + core bug affecting Perl 5.8 and 5.10 that could pass the wrong + context to the file scope of a required file, which breaks some + modules; this bug would only rarely afflict the core's require() + in situations where it would afflict require_module() + +version 0.010; 2011-10-07 + + * bugfix: in use_package_optimistically(), fix regexp interpolation + that broke operation if the module was loaded from a path containing + metacharacters + +version 0.009; 2011-10-04 + + * new function module_notional_filename() + + * simplify behaviour of use_package_optimistically() to match simplified + base.pm 2.18 + +version 0.008; 2011-05-16 + + * change usage of Params::Classify functions to take advantage of + custom ops in Params::Classify 0.012 + + * use full stricture in test suite + + * in Build.PL, complete declaration of configure-time requirements + + * explicitly state version required of Params::Classify + + * include META.json in distribution + + * add MYMETA.json and MYMETA.yml to .cvsignore + +version 0.007; 2010-03-19 + + * add "check_" functions for argument checking + + * supply regexps to check module name and spec syntax + + * in "is_" functions, also cleanly handle non-string arguments + + * in require_module() (also affecting use_module()), call require() + as a function (with appropriate name translation) instead of using + string eval, to avoid unnecessary complication of exception handling + + * provide the "is_valid_" functions under shorter "is_" names + + * revise POD markup + + * check for required Perl version at runtime + + * in tests, supply test modules to avoid requiring unrelated math + modules + + * in Build.PL, explicitly declare configure-time requirements + + * remove bogus "exit 0" from Build.PL + +version 0.006; 2009-05-19 + + * bugfix: avoid unreliable "\w" in regexps in code + + * document that module name syntax is restricted to ASCII + + * use simpler "parent" pragma in place of "base" + + * in documentation, use the term "truth value" instead of the less + precise "boolean" + + * use full stricture in Build.PL + +version 0.005; 2007-09-17 + + * bugfix: override any ambient $SIG{__DIE__} handler when using eval { } + + * use "base" pragma to import Exporter behaviour + + * test POD syntax and coverage, and rename an internal function to + satisfy the coverage test + + * build with Module::Build instead of ExtUtils::MakeMaker + + * complete dependency list + + * include signature in distribution + + * in documentation, separate "license" section from "copyright" section + +version 0.004; 2007-08-12 + + * change choice of module to test use_package_optimistically(), because + some old versions of Math::BigInt don't have a version number which + was causing a false test failure + +version 0.003; 2007-01-27 + + * loosen tests to work with perl v5.9's changed diagnostics + +version 0.002; 2006-06-15 + + * new function use_package_optimistically() to duplicate the "base" + pragma's quiet module loading + + * insert missing bracket in documentation for use_module() + +version 0.001; 2004-10-29 + + * new function use_module() + + * document return value of require_module() + + * more stringent tests for the return value of require_module() + + * explicitly declare lack of module dependencies in Makefile.PL + + * include Changes file + +version 0.000; 2004-02-15 + + * initial released version diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..0872a3e --- /dev/null +++ b/MANIFEST @@ -0,0 +1,30 @@ +.gitignore +Build.PL +Changes +MANIFEST +META.json +META.yml +Makefile.PL +README +lib/Module/Runtime.pm +t/Break.pm +t/Context.pm +t/Eval.pm +t/Hints.pm +t/Nest0.pm +t/Nest1.pm +t/Simple.pm +t/cmn.t +t/dependency.t +t/import_error.t +t/ivmn.t +t/ivms.t +t/mnf.t +t/pod_cvg.t +t/pod_syn.t +t/rm.t +t/taint.t +t/um.t +t/upo.t +t/upo_overridden.t +SIGNATURE Added here by Module::Build diff --git a/META.json b/META.json new file mode 100644 index 0000000..e20dc99 --- /dev/null +++ b/META.json @@ -0,0 +1,56 @@ +{ + "abstract" : "runtime module handling", + "author" : [ + "Andrew Main (Zefram) <zefram@fysh.org>" + ], + "dynamic_config" : 0, + "generated_by" : "Module::Build version 0.4204", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Module-Runtime", + "prereqs" : { + "build" : { + "requires" : { + "Module::Build" : "0", + "Test::More" : "0", + "perl" : "5.006", + "strict" : "0", + "warnings" : "0" + } + }, + "configure" : { + "requires" : { + "Module::Build" : "0", + "perl" : "5.006", + "strict" : "0", + "warnings" : "0" + } + }, + "runtime" : { + "requires" : { + "perl" : "5.006" + } + } + }, + "provides" : { + "Module::Runtime" : { + "file" : "lib/Module/Runtime.pm", + "version" : "0.014" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "url" : "git://git.fysh.org/zefram/Module-Runtime.git" + } + }, + "version" : "0.014" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..7f03870 --- /dev/null +++ b/META.yml @@ -0,0 +1,32 @@ +--- +abstract: 'runtime module handling' +author: + - 'Andrew Main (Zefram) <zefram@fysh.org>' +build_requires: + Module::Build: 0 + Test::More: 0 + perl: 5.006 + strict: 0 + warnings: 0 +configure_requires: + Module::Build: 0 + perl: 5.006 + strict: 0 + warnings: 0 +dynamic_config: 0 +generated_by: 'Module::Build version 0.4204, CPAN::Meta::Converter version 2.131560' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Module-Runtime +provides: + Module::Runtime: + file: lib/Module/Runtime.pm + version: 0.014 +requires: + perl: 5.006 +resources: + license: http://dev.perl.org/licenses/ + repository: git://git.fysh.org/zefram/Module-Runtime.git +version: 0.014 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..4ca6160 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,35 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.4204 +require 5.006; + + unless (eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = ExtUtils::MakeMaker::prompt + (' Install Module::Build now from CPAN?', 'y'); + + unless ($yn =~ /^y/i) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + + CPAN::Shell->install('Module::Build::Compat'); + CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate + or die "Couldn't install Module::Build, giving up.\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + + Module::Build::Compat->run_build_pl(args => \@ARGV); + my $build_script = 'Build'; + $build_script .= '.com' if $^O eq 'VMS'; + exit(0) unless(-e $build_script); # cpantesters convention + require Module::Build; + Module::Build::Compat->write_makefile(build_class => 'Module::Build'); @@ -0,0 +1,44 @@ +NAME + +Module::Runtime - runtime module handling + +DESCRIPTION + +The functions exported by this module deal with runtime handling of +Perl modules, which are normally handled at compile time. This module +avoids using any other modules, so that it can be used in low-level +infrastructure. + +The parts of this module that work with module names apply the same syntax +that is used for barewords in Perl source. In principle this syntax +can vary between versions of Perl, and this module applies the syntax of +the Perl on which it is running. In practice the usable syntax hasn't +changed yet. There's some intent for Unicode module names to be supported +in the future, but this hasn't yet amounted to any consistent facility. + +The functions of this module whose purpose is to load modules include +workarounds for three old Perl core bugs regarding "require". These +workarounds are applied on any Perl version where the bugs exist, except +for a case where one of the bugs cannot be adequately worked around in +pure Perl. + +INSTALLATION + + perl Build.PL + ./Build + ./Build test + ./Build install + +AUTHOR + +Andrew Main (Zefram) <zefram@fysh.org> + +COPYRIGHT + +Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014 +Andrew Main (Zefram) <zefram@fysh.org> + +LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. diff --git a/SIGNATURE b/SIGNATURE new file mode 100644 index 0000000..c519474 --- /dev/null +++ b/SIGNATURE @@ -0,0 +1,52 @@ +This file contains message digests of all files listed in MANIFEST, +signed via the Module::Signature module, version 0.73. + +To verify the content in this distribution, first make sure you have +Module::Signature installed, then type: + + % cpansign -v + +It will check each file's integrity, as well as the signature's +validity. If "==> Signature verified OK! <==" is not displayed, +the distribution may already have been compromised, and you should +not run its Makefile.PL or Build.PL. + +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +SHA1 846abd52ddad1c3141b395933fd10f14cb3cd7bc .gitignore +SHA1 550af94fde243fb4333061a2a7b03f274a6fb33f Build.PL +SHA1 132345e83b6e7293e7e011f5bb0f7fd9dcaf59ae Changes +SHA1 0f537563bf9b875501217c236e970f78ed04788b MANIFEST +SHA1 a8a5bf1ea3b6d09579aeb5930c721b7b817914a6 META.json +SHA1 0f7e531061b47d38c3962ab7dd2433c1ad062b28 META.yml +SHA1 0cfc7cc7e89b6334cf739d85244af8854a08b45d Makefile.PL +SHA1 35948979e61ed7586ffa28049ab3043232478473 README +SHA1 5d69c254f3af9104dcbe82c55a0260bbf81d2492 lib/Module/Runtime.pm +SHA1 e80e49f06f99a5b5bb0faf54988df29a7aff89c5 t/Break.pm +SHA1 c3c7b101e683f9f3d7f915763aa6d1850421bcb4 t/Context.pm +SHA1 fbe32c46e3fe2cac40e4ab173764aec7db9b2a00 t/Eval.pm +SHA1 d7f5ca01199b601b1a1a86127270d9ab7d1ca50b t/Hints.pm +SHA1 ffe7d868943d2340608382f87281098e5dd7b951 t/Nest0.pm +SHA1 e8bdcdde82209336e6c1f0123c283ec839d0efcb t/Nest1.pm +SHA1 f8988828e7cab17800a0b5f25547f09431933480 t/Simple.pm +SHA1 a0f9c0dfbe6472e81222a196a2f17554697d0d48 t/cmn.t +SHA1 7324434239bc0678904a4eb406f6c3b08951b162 t/dependency.t +SHA1 9331d0076c868209e9d3f0572d80f3e81df456df t/import_error.t +SHA1 fa24ea0033e10712a16c71466d488cd3e69e3697 t/ivmn.t +SHA1 84e207008efae1ed0ad21601d77205c2a8739fa5 t/ivms.t +SHA1 8adfb7863317a2d0962a2538800cb5ad3bda1690 t/mnf.t +SHA1 904d9a4f76525e2303e4b0c168c68230f223c8de t/pod_cvg.t +SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t +SHA1 2e9638c32424e2e58100d64cb74ac50a0b964d1b t/rm.t +SHA1 5a0ef5f7a982fbaff5d501165ae2720f465c7560 t/taint.t +SHA1 a57c7214dbd32d1dd814b30e45ac9dc3eaeebf4d t/um.t +SHA1 ddba26fbb70f1ac345b16b79098f96e36e812835 t/upo.t +SHA1 58c31b3e89d117d674da19600ce8d3967ecaaa6a t/upo_overridden.t +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.12 (GNU/Linux) + +iEYEARECAAYFAlL0CBwACgkQOV9mt2VyAVGAVACeOdEFo68kefBCRGYWXBoaC+a7 +eR8AnRO4eNYgF0t/ig68L/m5syrSkzCZ +=OmNr +-----END PGP SIGNATURE----- diff --git a/lib/Module/Runtime.pm b/lib/Module/Runtime.pm new file mode 100644 index 0000000..60bc177 --- /dev/null +++ b/lib/Module/Runtime.pm @@ -0,0 +1,505 @@ +=head1 NAME + +Module::Runtime - runtime module handling + +=head1 SYNOPSIS + + use Module::Runtime qw( + $module_name_rx is_module_name check_module_name + module_notional_filename require_module + ); + + if($module_name =~ /\A$module_name_rx\z/o) { ... + if(is_module_name($module_name)) { ... + check_module_name($module_name); + + $notional_filename = module_notional_filename($module_name); + require_module($module_name); + + use Module::Runtime qw(use_module use_package_optimistically); + + $bi = use_module("Math::BigInt", 1.31)->new("1_234"); + $widget = use_package_optimistically("Local::Widget")->new; + + use Module::Runtime qw( + $top_module_spec_rx $sub_module_spec_rx + is_module_spec check_module_spec + compose_module_name + ); + + if($spec =~ /\A$top_module_spec_rx\z/o) { ... + if($spec =~ /\A$sub_module_spec_rx\z/o) { ... + if(is_module_spec("Standard::Prefix", $spec)) { ... + check_module_spec("Standard::Prefix", $spec); + + $module_name = + compose_module_name("Standard::Prefix", $spec); + +=head1 DESCRIPTION + +The functions exported by this module deal with runtime handling of +Perl modules, which are normally handled at compile time. This module +avoids using any other modules, so that it can be used in low-level +infrastructure. + +The parts of this module that work with module names apply the same syntax +that is used for barewords in Perl source. In principle this syntax +can vary between versions of Perl, and this module applies the syntax of +the Perl on which it is running. In practice the usable syntax hasn't +changed yet. There's some intent for Unicode module names to be supported +in the future, but this hasn't yet amounted to any consistent facility. + +The functions of this module whose purpose is to load modules include +workarounds for three old Perl core bugs regarding C<require>. These +workarounds are applied on any Perl version where the bugs exist, except +for a case where one of the bugs cannot be adequately worked around in +pure Perl. + +=head2 Module name syntax + +The usable module name syntax has not changed from Perl 5.000 up to +Perl 5.19.8. The syntax is composed entirely of ASCII characters. +From Perl 5.6 onwards there has been some attempt to allow the use of +non-ASCII Unicode characters in Perl source, but it was fundamentally +broken (like the entirety of Perl 5.6's Unicode handling) and remained +pretty much entirely unusable until it got some attention in the Perl +5.15 series. Although Unicode is now consistently accepted by the +parser in some places, it remains broken for module names. Furthermore, +there has not yet been any work on how to map Unicode module names into +filenames, so in that respect also Unicode module names are unusable. + +The module name syntax is, precisely: the string must consist of one or +more segments separated by C<::>; each segment must consist of one or more +identifier characters (ASCII alphanumerics plus "_"); the first character +of the string must not be a digit. Thus "C<IO::File>", "C<warnings>", +and "C<foo::123::x_0>" are all valid module names, whereas "C<IO::>" +and "C<1foo::bar>" are not. C<'> separators are not permitted by this +module, though they remain usable in Perl source, being translated to +C<::> in the parser. + +=head2 Core bugs worked around + +The first bug worked around is core bug [perl #68590], which causes +lexical state in one file to leak into another that is C<require>d/C<use>d +from it. This bug is present from Perl 5.6 up to Perl 5.10, and is +fixed in Perl 5.11.0. From Perl 5.9.4 up to Perl 5.10.0 no satisfactory +workaround is possible in pure Perl. The workaround means that modules +loaded via this module don't suffer this pollution of their lexical +state. Modules loaded in other ways, or via this module on the Perl +versions where the pure Perl workaround is impossible, remain vulnerable. +The module L<Lexical::SealRequireHints> provides a complete workaround +for this bug. + +The second bug worked around causes some kinds of failure in module +loading, principally compilation errors in the loaded module, to be +recorded in C<%INC> as if they were successful, so later attempts to load +the same module immediately indicate success. This bug is present up +to Perl 5.8.9, and is fixed in Perl 5.9.0. The workaround means that a +compilation error in a module loaded via this module won't be cached as +a success. Modules loaded in other ways remain liable to produce bogus +C<%INC> entries, and if a bogus entry exists then it will mislead this +module if it is used to re-attempt loading. + +The third bug worked around causes the wrong context to be seen at +file scope of a loaded module, if C<require> is invoked in a location +that inherits context from a higher scope. This bug is present up to +Perl 5.11.2, and is fixed in Perl 5.11.3. The workaround means that +a module loaded via this module will always see the correct context. +Modules loaded in other ways remain vulnerable. + +=cut + +package Module::Runtime; + +# Don't "use 5.006" here, because Perl 5.15.6 will load feature.pm if +# the version check is done that way. +BEGIN { require 5.006; } +# Don't "use warnings" here, to avoid dependencies. Do standardise the +# warning status by lexical override; unfortunately the only safe bitset +# to build in is the empty set, equivalent to "no warnings". +BEGIN { ${^WARNING_BITS} = ""; } +# Don't "use strict" here, to avoid dependencies. + +our $VERSION = "0.014"; + +# Don't use Exporter here, to avoid dependencies. +our @EXPORT_OK = qw( + $module_name_rx is_module_name is_valid_module_name check_module_name + module_notional_filename require_module + use_module use_package_optimistically + $top_module_spec_rx $sub_module_spec_rx + is_module_spec is_valid_module_spec check_module_spec + compose_module_name +); +my %export_ok = map { ($_ => undef) } @EXPORT_OK; +sub import { + my $me = shift; + my $callpkg = caller(0); + my $errs = ""; + foreach(@_) { + if(exists $export_ok{$_}) { + # We would need to do "no strict 'refs'" here + # if we had enabled strict at file scope. + if(/\A\$(.*)\z/s) { + *{$callpkg."::".$1} = \$$1; + } else { + *{$callpkg."::".$_} = \&$_; + } + } else { + $errs .= "\"$_\" is not exported by the $me module\n"; + } + } + if($errs ne "") { + die "${errs}Can't continue after import errors ". + "at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n"; + } +} + +# Logic duplicated from Params::Classify. Duplicating it here avoids +# an extensive and potentially circular dependency graph. +sub _is_string($) { + my($arg) = @_; + return defined($arg) && ref(\$arg) eq "SCALAR"; +} + +=head1 REGULAR EXPRESSIONS + +These regular expressions do not include any anchors, so to check +whether an entire string matches a syntax item you must supply the +anchors yourself. + +=over + +=item $module_name_rx + +Matches a valid Perl module name in bareword syntax. + +=cut + +our $module_name_rx = qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/; + +=item $top_module_spec_rx + +Matches a module specification for use with L</compose_module_name>, +where no prefix is being used. + +=cut + +my $qual_module_spec_rx = + qr#(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#; + +my $unqual_top_module_spec_rx = + qr#[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#; + +our $top_module_spec_rx = qr/$qual_module_spec_rx|$unqual_top_module_spec_rx/o; + +=item $sub_module_spec_rx + +Matches a module specification for use with L</compose_module_name>, +where a prefix is being used. + +=cut + +my $unqual_sub_module_spec_rx = qr#[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*#; + +our $sub_module_spec_rx = qr/$qual_module_spec_rx|$unqual_sub_module_spec_rx/o; + +=back + +=head1 FUNCTIONS + +=head2 Basic module handling + +=over + +=item is_module_name(ARG) + +Returns a truth value indicating whether I<ARG> is a plain string +satisfying Perl module name syntax as described for L</$module_name_rx>. + +=cut + +sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o } + +=item is_valid_module_name(ARG) + +Deprecated alias for L</is_module_name>. + +=cut + +*is_valid_module_name = \&is_module_name; + +=item check_module_name(ARG) + +Check whether I<ARG> is a plain string +satisfying Perl module name syntax as described for L</$module_name_rx>. +Return normally if it is, or C<die> if it is not. + +=cut + +sub check_module_name($) { + unless(&is_module_name) { + die +(_is_string($_[0]) ? "`$_[0]'" : "argument"). + " is not a module name\n"; + } +} + +=item module_notional_filename(NAME) + +Generates a notional relative filename for a module, which is used in +some Perl core interfaces. +The I<NAME> is a string, which should be a valid module name (one or +more C<::>-separated segments). If it is not a valid name, the function +C<die>s. + +The notional filename for the named module is generated and returned. +This filename is always in Unix style, with C</> directory separators +and a C<.pm> suffix. This kind of filename can be used as an argument to +C<require>, and is the key that appears in C<%INC> to identify a module, +regardless of actual local filename syntax. + +=cut + +sub module_notional_filename($) { + &check_module_name; + my($name) = @_; + $name =~ s!::!/!g; + return $name.".pm"; +} + +=item require_module(NAME) + +This is essentially the bareword form of C<require>, in runtime form. +The I<NAME> is a string, which should be a valid module name (one or +more C<::>-separated segments). If it is not a valid name, the function +C<die>s. + +The module specified by I<NAME> is loaded, if it hasn't been already, +in the manner of the bareword form of C<require>. That means that a +search through C<@INC> is performed, and a byte-compiled form of the +module will be used if available. + +The return value is as for C<require>. That is, it is the value returned +by the module itself if the module is loaded anew, or C<1> if the module +was already loaded. + +=cut + +# Don't "use constant" here, to avoid dependencies. +BEGIN { + *_WORK_AROUND_HINT_LEAKAGE = + "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) + ? sub(){1} : sub(){0}; + *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; +} + +BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{ + sub Module::Runtime::__GUARD__::DESTROY { + delete $INC{$_[0]->[0]} if @{$_[0]}; + } + 1; +}; die $@ if $@ ne ""; } } + +sub require_module($) { + # Localise %^H to work around [perl #68590], where the bug exists + # and this is a satisfactory workaround. The bug consists of + # %^H state leaking into each required module, polluting the + # module's lexical state. + local %^H if _WORK_AROUND_HINT_LEAKAGE; + if(_WORK_AROUND_BROKEN_MODULE_STATE) { + my $notional_filename = &module_notional_filename; + my $guard = bless([ $notional_filename ], + "Module::Runtime::__GUARD__"); + my $result = CORE::require($notional_filename); + pop @$guard; + return $result; + } else { + return scalar(CORE::require(&module_notional_filename)); + } +} + +=back + +=head2 Structured module use + +=over + +=item use_module(NAME[, VERSION]) + +This is essentially C<use> in runtime form, but without the importing +feature (which is fundamentally a compile-time thing). The I<NAME> is +handled just like in C<require_module> above: it must be a module name, +and the named module is loaded as if by the bareword form of C<require>. + +If a I<VERSION> is specified, the C<VERSION> method of the loaded module is +called with the specified I<VERSION> as an argument. This normally serves to +ensure that the version loaded is at least the version required. This is +the same functionality provided by the I<VERSION> parameter of C<use>. + +On success, the name of the module is returned. This is unlike +L</require_module>, and is done so that the entire call to L</use_module> +can be used as a class name to call a constructor, as in the example in +the synopsis. + +=cut + +sub use_module($;$) { + my($name, $version) = @_; + require_module($name); + $name->VERSION($version) if @_ >= 2; + return $name; +} + +=item use_package_optimistically(NAME[, VERSION]) + +This is an analogue of L</use_module> for the situation where there is +uncertainty as to whether a package/class is defined in its own module +or by some other means. It attempts to arrange for the named package to +be available, either by loading a module or by doing nothing and hoping. + +An attempt is made to load the named module (as if by the bareword form +of C<require>). If the module cannot be found then it is assumed that +the package was actually already loaded by other means, and no error +is signalled. That's the optimistic bit. + +This is mostly the same operation that is performed by the L<base> pragma +to ensure that the specified base classes are available. The behaviour +of L<base> was simplified in version 2.18, and later improved in version +2.20, and on both occasions this function changed to match. + +If a I<VERSION> is specified, the C<VERSION> method of the loaded package is +called with the specified I<VERSION> as an argument. This normally serves +to ensure that the version loaded is at least the version required. +On success, the name of the package is returned. These aspects of the +function work just like L</use_module>. + +=cut + +sub use_package_optimistically($;$) { + my($name, $version) = @_; + my $fn = module_notional_filename($name); + eval { local $SIG{__DIE__}; require_module($name); }; + die $@ if $@ ne "" && + ($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s || + $@ =~ /^Compilation\ failed\ in\ require + \ at\ \Q@{[__FILE__]}\E\ line/xm); + $name->VERSION($version) if @_ >= 2; + return $name; +} + +=back + +=head2 Module name composition + +=over + +=item is_module_spec(PREFIX, SPEC) + +Returns a truth value indicating +whether I<SPEC> is valid input for L</compose_module_name>. +See below for what that entails. Whether a I<PREFIX> is supplied affects +the validity of I<SPEC>, but the exact value of the prefix is unimportant, +so this function treats I<PREFIX> as a truth value. + +=cut + +sub is_module_spec($$) { + my($prefix, $spec) = @_; + return _is_string($spec) && + $spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o : + qr/\A$top_module_spec_rx\z/o); +} + +=item is_valid_module_spec(PREFIX, SPEC) + +Deprecated alias for L</is_module_spec>. + +=cut + +*is_valid_module_spec = \&is_module_spec; + +=item check_module_spec(PREFIX, SPEC) + +Check whether I<SPEC> is valid input for L</compose_module_name>. +Return normally if it is, or C<die> if it is not. + +=cut + +sub check_module_spec($$) { + unless(&is_module_spec) { + die +(_is_string($_[1]) ? "`$_[1]'" : "argument"). + " is not a module specification\n"; + } +} + +=item compose_module_name(PREFIX, SPEC) + +This function is intended to make it more convenient for a user to specify +a Perl module name at runtime. Users have greater need for abbreviations +and context-sensitivity than programmers, and Perl module names get a +little unwieldy. I<SPEC> is what the user specifies, and this function +translates it into a module name in standard form, which it returns. + +I<SPEC> has syntax approximately that of a standard module name: it +should consist of one or more name segments, each of which consists +of one or more identifier characters. However, C</> is permitted as a +separator, in addition to the standard C<::>. The two separators are +entirely interchangeable. + +Additionally, if I<PREFIX> is not C<undef> then it must be a module +name in standard form, and it is prefixed to the user-specified name. +The user can inhibit the prefix addition by starting I<SPEC> with a +separator (either C</> or C<::>). + +=cut + +sub compose_module_name($$) { + my($prefix, $spec) = @_; + check_module_name($prefix) if defined $prefix; + &check_module_spec; + if($spec =~ s#\A(?:/|::)##) { + # OK + } else { + $spec = $prefix."::".$spec if defined $prefix; + } + $spec =~ s#/#::#g; + return $spec; +} + +=back + +=head1 BUGS + +On Perl versions 5.7.2 to 5.8.8, if C<require> is overridden by the +C<CORE::GLOBAL> mechanism, it is likely to break the heuristics used by +L</use_package_optimistically>, making it signal an error for a missing +module rather than assume that it was already loaded. From Perl 5.8.9 +onwards, and on 5.7.1 and earlier, this module can avoid being confused +by such an override. On the affected versions, a C<require> override +might be installed by L<Lexical::SealRequireHints>, if something requires +its bugfix but for some reason its XS implementation isn't available. + +=head1 SEE ALSO + +L<Lexical::SealRequireHints>, +L<base>, +L<perlfunc/require>, +L<perlfunc/use> + +=head1 AUTHOR + +Andrew Main (Zefram) <zefram@fysh.org> + +=head1 COPYRIGHT + +Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014 +Andrew Main (Zefram) <zefram@fysh.org> + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; diff --git a/t/Break.pm b/t/Break.pm new file mode 100644 index 0000000..6214092 --- /dev/null +++ b/t/Break.pm @@ -0,0 +1,7 @@ +package t::Break; + +{ use 5.006; } +use warnings; +use strict; + +die "broken"; diff --git a/t/Context.pm b/t/Context.pm new file mode 100644 index 0000000..83cd5bb --- /dev/null +++ b/t/Context.pm @@ -0,0 +1,12 @@ +package t::Context; + +{ use 5.006; } +use warnings; +use strict; + +our $VERSION = 1; + +die "t::Context sees array context at file scope" if wantarray; +die "t::Context sees void context at file scope" unless defined wantarray; + +"t::Context return"; diff --git a/t/Eval.pm b/t/Eval.pm new file mode 100644 index 0000000..bbd49e5 --- /dev/null +++ b/t/Eval.pm @@ -0,0 +1,41 @@ +package t::Eval; + +use warnings; +use strict; + +use Test::More; + +sub _ok_no_eval() { + my $lastsub = ""; + my $i = 0; + while(1) { + my @c = caller($i); + unless(@c) { + ok 0; + diag "failed to find main program in stack trace"; + return; + } + my $sub = $c[3]; + if($sub eq "main::eval_test") { + ok 1; + return; + } + my $type = $sub ne "(eval)" ? "subroutine" : + $c[7] ? "require" : + defined($c[6]) ? "string eval" : "block eval"; + if($type =~ /eval/ && !($lastsub eq "t::Eval::BEGIN" && + $type eq "block eval")) { + ok 0; + diag "have $type between module and main program"; + return; + } + $lastsub = $sub; + $i++; + } +} + +BEGIN { _ok_no_eval(); } +_ok_no_eval(); +sub import { _ok_no_eval(); } + +1; diff --git a/t/Hints.pm b/t/Hints.pm new file mode 100644 index 0000000..7461d49 --- /dev/null +++ b/t/Hints.pm @@ -0,0 +1,17 @@ +package t::Hints; + +use warnings; +use strict; + +use Test::More; + +BEGIN { is $^H{"Module::Runtime/test_a"}, undef; } +main::test_runtime_hint_hash "Module::Runtime/test_a", undef; + +sub import { + is $^H{"Module::Runtime/test_a"}, 1; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_b"} = 1; +} + +1; diff --git a/t/Nest0.pm b/t/Nest0.pm new file mode 100644 index 0000000..06e1c44 --- /dev/null +++ b/t/Nest0.pm @@ -0,0 +1,10 @@ +package t::Nest0; + +{ use 5.006; } +use warnings; +use strict; +use t::Nested; + +our $VERSION = 1; + +"t::Nest0 return"; diff --git a/t/Nest1.pm b/t/Nest1.pm new file mode 100644 index 0000000..8b81696 --- /dev/null +++ b/t/Nest1.pm @@ -0,0 +1,12 @@ +package t::Nest1; + +{ use 5.006; } +use warnings; +use strict; +use Module::Runtime qw(require_module); + +our $VERSION = 1; + +require_module("t::Nested"); + +"t::Nest1 return"; diff --git a/t/Simple.pm b/t/Simple.pm new file mode 100644 index 0000000..c70eb65 --- /dev/null +++ b/t/Simple.pm @@ -0,0 +1,9 @@ +package t::Simple; + +{ use 5.006; } +use warnings; +use strict; + +our $VERSION = 1; + +"t::Simple return"; @@ -0,0 +1,25 @@ +use warnings; +use strict; + +use Test::More tests => 17; + +BEGIN { use_ok "Module::Runtime", qw(compose_module_name); } + +is(compose_module_name(undef, "foo"), "foo"); +is(compose_module_name(undef, "foo::bar"), "foo::bar"); +is(compose_module_name(undef, "foo/bar"), "foo::bar"); +is(compose_module_name(undef, "foo/bar/baz"), "foo::bar::baz"); +is(compose_module_name(undef, "/foo"), "foo"); +is(compose_module_name(undef, "/foo::bar"), "foo::bar"); +is(compose_module_name(undef, "::foo/bar"), "foo::bar"); +is(compose_module_name(undef, "::foo/bar/baz"), "foo::bar::baz"); +is(compose_module_name("a::b", "foo"), "a::b::foo"); +is(compose_module_name("a::b", "foo::bar"), "a::b::foo::bar"); +is(compose_module_name("a::b", "foo/bar"), "a::b::foo::bar"); +is(compose_module_name("a::b", "foo/bar/baz"), "a::b::foo::bar::baz"); +is(compose_module_name("a::b", "/foo"), "foo"); +is(compose_module_name("a::b", "/foo::bar"), "foo::bar"); +is(compose_module_name("a::b", "::foo/bar"), "foo::bar"); +is(compose_module_name("a::b", "::foo/bar/baz"), "foo::bar::baz"); + +1; diff --git a/t/dependency.t b/t/dependency.t new file mode 100644 index 0000000..8c8f9d0 --- /dev/null +++ b/t/dependency.t @@ -0,0 +1,11 @@ +# This test checks that M:R doesn't load any other modules. Hence this +# script cannot itself use warnings, Test::More, or any other module. + +BEGIN { print "1..1\n"; } +our(%preloaded, @extraloaded); +BEGIN { %preloaded = %INC; } +use Module::Runtime qw(require_module); +BEGIN { @extraloaded = sort grep { !exists($preloaded{$_}) } keys %INC; } +print join(" ", @extraloaded) eq "Module/Runtime.pm" ? "" : "not ", "ok 1\n"; + +1; diff --git a/t/import_error.t b/t/import_error.t new file mode 100644 index 0000000..b9b8de3 --- /dev/null +++ b/t/import_error.t @@ -0,0 +1,35 @@ +use warnings; +use strict; + +use Test::More tests => 3; + +eval q{#line 11 "test_eval" + use Module::Runtime qw(foo); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 11/ if "$]" < 5.006001; +like $@, qr/\A + \"foo\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 11.\n +/x; + +eval q{#line 22 "test_eval" + use Module::Runtime qw(require_module.1); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 22/ if "$]" < 5.006001; +like $@, qr/\A + \"require_module.1\"\ is\ not\ exported + \ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 22.\n +/x; + +eval q{#line 33 "test_eval" + use Module::Runtime qw(foo require_module bar); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 33/ if "$]" < 5.006001; +like $@, qr/\A + \"foo\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + \"bar\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 33.\n +/x; + +1; diff --git a/t/ivmn.t b/t/ivmn.t new file mode 100644 index 0000000..c252e7f --- /dev/null +++ b/t/ivmn.t @@ -0,0 +1,49 @@ +use warnings; +use strict; + +use Test::More tests => 47; + +BEGIN { use_ok "Module::Runtime", qw( + $module_name_rx is_module_name is_valid_module_name check_module_name +); } + +ok \&is_valid_module_name == \&is_module_name; + +foreach my $name ( + undef, + *STDOUT, + \"Foo", + [], + {}, + sub{}, +) { + ok(!is_module_name($name), "non-string is bad (function)"); + eval { check_module_name($name) }; isnt $@, ""; +} + +foreach my $name (qw( + Foo + foo::bar + IO::File + foo::123::x_0 + _ +)) { + ok(is_module_name($name), "`$name' is good (function)"); + eval { check_module_name($name) }; is $@, ""; + ok($name =~ /\A$module_name_rx\z/, "`$name' is good (regexp)"); +} + +foreach my $name (qw( + foo'bar + foo/bar + IO:: + 1foo::bar + ::foo + foo::::bar +)) { + ok(!is_module_name($name), "`$name' is bad (function)"); + eval { check_module_name($name) }; isnt $@, ""; + ok($name !~ /\A$module_name_rx\z/, "`$name' is bad (regexp)"); +} + +1; diff --git a/t/ivms.t b/t/ivms.t new file mode 100644 index 0000000..0c92890 --- /dev/null +++ b/t/ivms.t @@ -0,0 +1,82 @@ +use warnings; +use strict; + +use Test::More tests => 140; + +BEGIN { use_ok "Module::Runtime", qw( + $top_module_spec_rx $sub_module_spec_rx + is_module_spec is_valid_module_spec check_module_spec +); } + +ok \&is_valid_module_spec == \&is_module_spec; + +foreach my $spec ( + undef, + *STDOUT, + \"Foo", + [], + {}, + sub{}, +) { + ok(!is_module_spec(0, $spec), "non-string is bad (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok(!is_module_spec(1, $spec), "non-string is bad (function)"); + eval { check_module_spec(1, $spec) }; isnt $@, ""; +} + +foreach my $spec (qw( + Foo + foo::bar + foo::123::x_0 + foo/bar + foo/123::x_0 + foo::123/x_0 + foo/123/x_0 + /Foo + /foo/bar + ::foo/bar +)) { + ok(is_module_spec(0, $spec), "`$spec' is always good (function)"); + eval { check_module_spec(0, $spec) }; is $@, ""; + ok($spec =~ qr/\A$top_module_spec_rx\z/, + "`$spec' is always good (regexp)"); + ok(is_module_spec(1, $spec), "`$spec' is always good (function)"); + eval { check_module_spec(1, $spec) }; is $@, ""; + ok($spec =~ qr/\A$sub_module_spec_rx\z/, + "`$spec' is always good (regexp)"); +} + +foreach my $spec (qw( + foo'bar + IO:: + foo::::bar + /foo/ + /1foo + ::foo:: + ::1foo +)) { + ok(!is_module_spec(0, $spec), "`$spec' is always bad (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$top_module_spec_rx\z/, + "`$spec' is always bad (regexp)"); + ok(!is_module_spec(1, $spec), "`$spec' is always bad (function)"); + eval { check_module_spec(1, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$sub_module_spec_rx\z/, + "`$spec' is always bad (regexp)"); +} + +foreach my $spec (qw( + 1foo + 0/1 +)) { + ok(!is_module_spec(0, $spec), "`$spec' needs a prefix (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$top_module_spec_rx\z/, + "`$spec' needs a prefix (regexp)"); + ok(is_module_spec(1, $spec), "`$spec' needs a prefix (function)"); + eval { check_module_spec(1, $spec) }; is $@, ""; + ok($spec =~ qr/\A$sub_module_spec_rx\z/, + "`$spec' needs a prefix (regexp)"); +} + +1; @@ -0,0 +1,13 @@ +use warnings; +use strict; + +use Test::More tests => 5; + +BEGIN { use_ok "Module::Runtime", qw(module_notional_filename); } + +is module_notional_filename("Test::More"), "Test/More.pm"; +is module_notional_filename("Test::More::Widgets"), "Test/More/Widgets.pm"; +is module_notional_filename("Foo::0Bar::Baz"), "Foo/0Bar/Baz.pm"; +is module_notional_filename("Foo"), "Foo.pm"; + +1; diff --git a/t/pod_cvg.t b/t/pod_cvg.t new file mode 100644 index 0000000..64f6c48 --- /dev/null +++ b/t/pod_cvg.t @@ -0,0 +1,9 @@ +use warnings; +use strict; + +use Test::More; +plan skip_all => "Test::Pod::Coverage not available" + unless eval "use Test::Pod::Coverage; 1"; +Test::Pod::Coverage::all_pod_coverage_ok(); + +1; diff --git a/t/pod_syn.t b/t/pod_syn.t new file mode 100644 index 0000000..6f004ac --- /dev/null +++ b/t/pod_syn.t @@ -0,0 +1,8 @@ +use warnings; +use strict; + +use Test::More; +plan skip_all => "Test::Pod not available" unless eval "use Test::Pod 1.00; 1"; +Test::Pod::all_pod_files_ok(); + +1; @@ -0,0 +1,86 @@ +use warnings; +use strict; + +use Test::More tests => 26; + +BEGIN { use_ok "Module::Runtime", qw(require_module); } + +my($result, $err); + +sub test_require_module($) { + my($name) = @_; + $result = eval { require_module($name) }; + $err = $@; +} + +# a module that doesn't exist +test_require_module("t::NotExist"); +like($err, qr/^Can't locate /); + +# a module that's already loaded +test_require_module("Test::More"); +is($err, ""); +is($result, 1); + +# a module that we'll load now +test_require_module("t::Simple"); +is($err, ""); +is($result, "t::Simple return"); + +# re-requiring the module that we just loaded +test_require_module("t::Simple"); +is($err, ""); +is($result, 1); + +# module file scope sees scalar context regardless of calling context +eval { require_module("t::Context"); 1 }; +is $@, ""; + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + require_module("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { require_module("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { require_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { require_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# no extra eval frame +SKIP: { + skip "core bug makes this test crash", 2 if "$]" < 5.006001; + sub eval_test () { require_module("t::Eval") } + eval_test(); +} + +1; diff --git a/t/taint.t b/t/taint.t new file mode 100644 index 0000000..fd6e44c --- /dev/null +++ b/t/taint.t @@ -0,0 +1,24 @@ +#!perl -T +# above line is required to enable taint mode + +use warnings; +use strict; + +use Test::More tests => 5; + +BEGIN { + use_ok "Module::Runtime", + qw(require_module use_module use_package_optimistically); +} + +my $tainted_modname = substr($ENV{PATH}, 0, 0) . "Module::Runtime"; +eval { require_module($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { use_module($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { use_package_optimistically($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { require_module("Module::Runtime") }; +is $@, ""; + +1; @@ -0,0 +1,111 @@ +use warnings; +use strict; + +use Test::More tests => 37; + +BEGIN { use_ok "Module::Runtime", qw(use_module); } + +my $result; + +# a module that doesn't exist +$result = eval { use_module("t::NotExist") }; +like($@, qr/^Can't locate /); + +# a module that's already loaded +$result = eval { use_module("Test::More") }; +is($@, ""); +is($result, "Test::More"); + +# a module that we'll load now +$result = eval { use_module("t::Simple") }; +is($@, ""); +is($result, "t::Simple"); + +# re-requiring the module that we just loaded +$result = eval { use_module("t::Simple") }; +is($@, ""); +is($result, "t::Simple"); + +# module file scope sees scalar context regardless of calling context +$result = eval { use_module("t::Context"); 1 }; +is $@, ""; + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + use_module("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { use_module("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { use_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { use_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# no extra eval frame +SKIP: { + skip "core bug makes this test crash", 2 if "$]" < 5.006001; + sub eval_test () { use_module("t::Eval") } + eval_test(); +} + +# successful version check +$result = eval { use_module("Module::Runtime", 0.001) }; +is($@, ""); +is($result, "Module::Runtime"); + +# failing version check +$result = eval { use_module("Module::Runtime", 999) }; +like($@, qr/^Module::Runtime version /); + +# make sure any version argument gets passed through +my @version_calls; +sub t::HasVersion::VERSION { + push @version_calls, [@_]; +} +$INC{"t/HasVersion.pm"} = 1; +eval { use_module("t::HasVersion") }; +is $@, ""; +is_deeply \@version_calls, []; +@version_calls = (); +eval { use_module("t::HasVersion", 2) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",2]]; +@version_calls = (); +eval { use_module("t::HasVersion", "wibble") }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion","wibble"]]; +@version_calls = (); +eval { use_module("t::HasVersion", undef) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",undef]]; + +1; @@ -0,0 +1,120 @@ +use warnings; +use strict; + +use Test::More tests => 42; + +BEGIN { use_ok "Module::Runtime", qw(use_package_optimistically); } + +my $result; + +# a module that doesn't exist +$result = eval { use_package_optimistically("t::NotExist") }; +is $@, ""; +is $result, "t::NotExist"; + +# a module that's already loaded +$result = eval { use_package_optimistically("Test::More") }; +is $@, ""; +is $result, "Test::More"; + +# a module that we'll load now +$result = eval { use_package_optimistically("t::Simple") }; +is $@, ""; +is $result, "t::Simple"; +no strict "refs"; +ok defined(${"t::Simple::VERSION"}); + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + use_package_optimistically("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { use_package_optimistically("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { use_package_optimistically("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { use_package_optimistically("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# module broken by virtue of trying to non-optimistically load a +# non-existent module via "use" +eval { use_package_optimistically("t::Nest0") }; +like $@, qr/\ACan't locate /; +eval { use_package_optimistically("t::Nest0") }; +like $@, qr/\A(?:Can't locate |Attempt to reload )/; + +# module broken by virtue of trying to non-optimistically load a +# non-existent module via require_module() +eval { use_package_optimistically("t::Nest1") }; +like $@, qr/\ACan't locate /; +eval { use_package_optimistically("t::Nest1") }; +like $@, qr/\A(?:Can't locate |Attempt to reload )/; + +# successful version check +$result = eval { use_package_optimistically("Module::Runtime", 0.001) }; +is $@, ""; +is $result, "Module::Runtime"; + +# failing version check +$result = eval { use_package_optimistically("Module::Runtime", 999) }; +like $@, qr/^Module::Runtime version /; + +# even load module if $VERSION already set, unlike older behaviour +$t::Context::VERSION = undef; +$result = eval { use_package_optimistically("t::Context") }; +is $@, ""; +is $result, "t::Context"; +ok defined($t::Context::VERSION); +ok $INC{"t/Context.pm"}; + +# make sure any version argument gets passed through +my @version_calls; +sub t::HasVersion::VERSION { + push @version_calls, [@_]; +} +$INC{"t/HasVersion.pm"} = 1; +eval { use_package_optimistically("t::HasVersion") }; +is $@, ""; +is_deeply \@version_calls, []; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", 2) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",2]]; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", "wibble") }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion","wibble"]]; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", undef) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",undef]]; + +1; diff --git a/t/upo_overridden.t b/t/upo_overridden.t new file mode 100644 index 0000000..2cd9cc1 --- /dev/null +++ b/t/upo_overridden.t @@ -0,0 +1,19 @@ +use warnings; +use strict; + +if("$]" < 5.007002) { + require Test::More; + Test::More::plan(skip_all => + "require override can't work acceptably on this perl"); +} elsif("$]" >= 5.007002 && "$]" < 5.008009) { + require Test::More; + Test::More::plan(skip_all => + "require override can't be dodged on this perl"); +} + +no warnings "once"; +*CORE::GLOBAL::require = sub { require $_[0] }; + +do "t/upo.t" or die $@ || $!; + +1; |