From 4610e5e2c32de5ab6ed56187b8c3e1a246cad160 Mon Sep 17 00:00:00 2001 From: TizenOpenSource Date: Wed, 14 Feb 2024 11:27:50 +0900 Subject: [PATCH] Imported Upstream version 0.016 --- .gitignore | 11 + Build.PL | 47 ++++ Changes | 214 ++++++++++++++++++ MANIFEST | 30 +++ META.json | 62 +++++ META.yml | 34 +++ Makefile.PL | 18 ++ README | 44 ++++ SIGNATURE | 52 +++++ lib/Module/Runtime.pm | 515 ++++++++++++++++++++++++++++++++++++++++++ t/cmn.t | 25 ++ t/dependency.t | 11 + t/import_error.t | 35 +++ t/ivmn.t | 49 ++++ t/ivms.t | 82 +++++++ t/lib/t/Break.pm | 7 + t/lib/t/Context.pm | 12 + t/lib/t/Eval.pm | 41 ++++ t/lib/t/Hints.pm | 17 ++ t/lib/t/Nest0.pm | 10 + t/lib/t/Nest1.pm | 12 + t/lib/t/Simple.pm | 9 + t/mnf.t | 13 ++ t/pod_cvg.t | 9 + t/pod_syn.t | 8 + t/rm.t | 87 +++++++ t/taint.t | 33 +++ t/um.t | 112 +++++++++ t/upo.t | 121 ++++++++++ t/upo_overridden.t | 19 ++ 30 files changed, 1739 insertions(+) create mode 100644 .gitignore create mode 100644 Build.PL create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 SIGNATURE create mode 100644 lib/Module/Runtime.pm create mode 100644 t/cmn.t create mode 100644 t/dependency.t create mode 100644 t/import_error.t create mode 100644 t/ivmn.t create mode 100644 t/ivms.t create mode 100644 t/lib/t/Break.pm create mode 100644 t/lib/t/Context.pm create mode 100644 t/lib/t/Eval.pm create mode 100644 t/lib/t/Hints.pm create mode 100644 t/lib/t/Nest0.pm create mode 100644 t/lib/t/Nest1.pm create mode 100644 t/lib/t/Simple.pm create mode 100644 t/mnf.t create mode 100644 t/pod_cvg.t create mode 100644 t/pod_syn.t create mode 100644 t/rm.t create mode 100644 t/taint.t create mode 100644 t/um.t create mode 100644 t/upo.t create mode 100644 t/upo_overridden.t 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..cba4b79 --- /dev/null +++ b/Build.PL @@ -0,0 +1,47 @@ +{ 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.41", + "perl" => "5.006", + "strict" => 0, + "warnings" => 0, + }, + requires => { + "perl" => "5.006", + }, + dynamic_config => 0, + meta_add => { distribution_type => "module" }, + meta_merge => { + "meta-spec" => { version => "2" }, + resources => { + bugtracker => { + mailto => "bug-Module-Runtime\@rt.cpan.org", + web => "https://rt.cpan.org/Public/Dist/". + "Display.html?Name=Module-Runtime", + }, + repository => { + type => "git", + url => "git://git.fysh.org/zefram/". + "Module-Runtime.git", + }, + }, + }, + create_makefile_pl => "traditional", + sign => 1, +)->create_build_script; + +1; diff --git a/Changes b/Changes new file mode 100644 index 0000000..20fa1bf --- /dev/null +++ b/Changes @@ -0,0 +1,214 @@ +version 0.016; 2017-10-17 + + * port t/taint.t to Perl 5.27.5, where re-requiring an already-loaded + module doesn't trigger tainting + + * skip t/taint.t if the perl empirically doesn't perform taint checks + but the script got run anyway (which happens with an unsupported + configuration of the Perl core which some people are using in the + absence of a supported no-taint configuration) + + * in t/taint.t, use $^X rather than $ENV{PATH} as the primordial + tainted value to taint a string being tested + + * in documentation, use four-column indentation for all verbatim + material + + * in META.{yml,json}, point to public bug tracker + + * in META.json, specify type of public repository + +version 0.015; 2017-07-16 + + * update test suite to not rely on . in @INC, which is no longer + necessarily there from Perl 5.25.7 + + * in documentation, warn about the security problem with + use_package_optimistically() + + * declare correct version for Test::More dependency + + * generate "traditional" style of compatibility Makefile.PL, to + permit building in environments that don't support Build.PL or + configure_requires + +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..9bfc790 --- /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/cmn.t +t/dependency.t +t/import_error.t +t/ivmn.t +t/ivms.t +t/lib/t/Break.pm +t/lib/t/Context.pm +t/lib/t/Eval.pm +t/lib/t/Hints.pm +t/lib/t/Nest0.pm +t/lib/t/Nest1.pm +t/lib/t/Simple.pm +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..94df26c --- /dev/null +++ b/META.json @@ -0,0 +1,62 @@ +{ + "abstract" : "runtime module handling", + "author" : [ + "Andrew Main (Zefram) " + ], + "dynamic_config" : 0, + "generated_by" : "Module::Build version 0.4224", + "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.41", + "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.016" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "mailto" : "bug-Module-Runtime@rt.cpan.org", + "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Runtime" + }, + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "type" : "git", + "url" : "git://git.fysh.org/zefram/Module-Runtime.git" + } + }, + "version" : "0.016", + "x_serialization_backend" : "JSON::PP version 2.93" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..23ef523 --- /dev/null +++ b/META.yml @@ -0,0 +1,34 @@ +--- +abstract: 'runtime module handling' +author: + - 'Andrew Main (Zefram) ' +build_requires: + Module::Build: '0' + Test::More: '0.41' + 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.4224, CPAN::Meta::Converter version 2.150010' +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.016' +requires: + perl: '5.006' +resources: + bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Runtime + license: http://dev.perl.org/licenses/ + repository: git://git.fysh.org/zefram/Module-Runtime.git +version: '0.016' +x_serialization_backend: 'CPAN::Meta::YAML version 0.012' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..b691b5c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.4224 +require 5.006; +use ExtUtils::MakeMaker; +WriteMakefile +( + 'PL_FILES' => {}, + 'INSTALLDIRS' => 'site', + 'NAME' => 'Module::Runtime', + 'EXE_FILES' => [], + 'VERSION_FROM' => 'lib/Module/Runtime.pm', + 'PREREQ_PM' => { + 'warnings' => 0, + 'strict' => 0, + 'Test::More' => '0.41', + 'Module::Build' => 0 + } +) +; diff --git a/README b/README new file mode 100644 index 0000000..8797570 --- /dev/null +++ b/README @@ -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) + +COPYRIGHT + +Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014, 2017 +Andrew Main (Zefram) + +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..327e172 --- /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.81. + +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 cf2a8e9c893c079aec5ac8fca8bf5afc472554fb Build.PL +SHA1 9fd88b5a09db2882fe419ca398ab648c89f39fa2 Changes +SHA1 9546eeb74b22a29325aa9f25680754de1d2c66bd MANIFEST +SHA1 7d82b740ac1da751490d3b18d22b873b55888b7c META.json +SHA1 ae3deefcdeb95a151b603476b81ca5c8cf2b682f META.yml +SHA1 6c97007f942e3d79516bad3e17cae3df3f5d6fe7 Makefile.PL +SHA1 f39acd66237fdd46b843b872bf5636135afe0b07 README +SHA1 d20b3430d9b582c107f71f2fcab8bc5351a1f521 lib/Module/Runtime.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 e80e49f06f99a5b5bb0faf54988df29a7aff89c5 t/lib/t/Break.pm +SHA1 c3c7b101e683f9f3d7f915763aa6d1850421bcb4 t/lib/t/Context.pm +SHA1 d24b0d20f4e663d4d909756f49c7bcd4752d13b8 t/lib/t/Eval.pm +SHA1 d7f5ca01199b601b1a1a86127270d9ab7d1ca50b t/lib/t/Hints.pm +SHA1 ffe7d868943d2340608382f87281098e5dd7b951 t/lib/t/Nest0.pm +SHA1 e8bdcdde82209336e6c1f0123c283ec839d0efcb t/lib/t/Nest1.pm +SHA1 f8988828e7cab17800a0b5f25547f09431933480 t/lib/t/Simple.pm +SHA1 8adfb7863317a2d0962a2538800cb5ad3bda1690 t/mnf.t +SHA1 904d9a4f76525e2303e4b0c168c68230f223c8de t/pod_cvg.t +SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t +SHA1 256e6d474b59dae11fd569f132c09079f9ac216a t/rm.t +SHA1 c7ec563b949b91a3c7b5c864607fcb8d7a0cfb9d t/taint.t +SHA1 bfbc137c2e8721b12779c04c19869285714e0348 t/um.t +SHA1 bf6317856eea0f9e36ddb75af8eda52f88a1d77f t/upo.t +SHA1 0c5244ef9cc8c0ff2e07a6b8eb04ed742994aae9 t/upo_overridden.t +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1 + +iEYEARECAAYFAlnmZ7kACgkQOV9mt2VyAVEj/gCeKs9vDfTwdU6OsSuxxGXYA9Gv +PjkAnjPcXkbc5Eb6lWAEiHJbn2CnM16e +=X0zz +-----END PGP SIGNATURE----- diff --git a/lib/Module/Runtime.pm b/lib/Module/Runtime.pm new file mode 100644 index 0000000..b6c47ba --- /dev/null +++ b/lib/Module/Runtime.pm @@ -0,0 +1,515 @@ +=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. 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", "C", +and "C" are all valid module names, whereas "C" +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 Cd/Cd +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 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 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.016"; + +# 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, +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, +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 is a plain string +satisfying Perl module name syntax as described for L. + +=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. + +=cut + +*is_valid_module_name = \&is_module_name; + +=item check_module_name(ARG) + +Check whether I is a plain string +satisfying Perl module name syntax as described for L. +Return normally if it is, or C 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 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 +Cs. + +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, 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, in runtime form. +The I 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 +Cs. + +The module specified by I is loaded, if it hasn't been already, +in the manner of the bareword form of C. 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. 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 in runtime form, but without the importing +feature (which is fundamentally a compile-time thing). The I is +handled just like in C above: it must be a module name, +and the named module is loaded as if by the bareword form of C. + +If a I is specified, the C method of the loaded module is +called with the specified I 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 parameter of C. + +On success, the name of the module is returned. This is unlike +L, and is done so that the entire call to L +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 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). 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. + +I this optional module loading is liable to cause unreliable +behaviour, including security problems. It interacts especially badly +with having C<.> in C<@INC>, which was the default state of affairs in +Perls prior to 5.25.11. If a package is actually defined by some means +other than a module, then applying this function to it causes a spurious +attempt to load a module that is expected to be non-existent. If a +module actually exists under that name then it will be unintentionally +loaded. If C<.> is in C<@INC> and this code is ever run with the current +directory being one writable by a malicious user (such as F), then +the malicious user can easily cause the victim to run arbitrary code, by +creating a module file under the predictable spuriously-loaded name in the +writable directory. Generally, optional module loading should be avoided. + +This is mostly the same operation that is performed by the L pragma +to ensure that the specified base classes are available. The behaviour +of L 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 is specified, the C method of the loaded package is +called with the specified I 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. + +=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 is valid input for L. +See below for what that entails. Whether a I is supplied affects +the validity of I, but the exact value of the prefix is unimportant, +so this function treats I 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. + +=cut + +*is_valid_module_spec = \&is_module_spec; + +=item check_module_spec(PREFIX, SPEC) + +Check whether I is valid input for L. +Return normally if it is, or C 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 is what the user specifies, and this function +translates it into a module name in standard form, which it returns. + +I 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 is not C 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 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 is overridden by the +C mechanism, it is likely to break the heuristics used by +L, 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 override +might be installed by L, if something requires +its bugfix but for some reason its XS implementation isn't available. + +=head1 SEE ALSO + +L, +L, +L, +L + +=head1 AUTHOR + +Andrew Main (Zefram) + +=head1 COPYRIGHT + +Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014, 2017 +Andrew Main (Zefram) + +=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/cmn.t b/t/cmn.t new file mode 100644 index 0000000..8717b55 --- /dev/null +++ b/t/cmn.t @@ -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; diff --git a/t/lib/t/Break.pm b/t/lib/t/Break.pm new file mode 100644 index 0000000..6214092 --- /dev/null +++ b/t/lib/t/Break.pm @@ -0,0 +1,7 @@ +package t::Break; + +{ use 5.006; } +use warnings; +use strict; + +die "broken"; diff --git a/t/lib/t/Context.pm b/t/lib/t/Context.pm new file mode 100644 index 0000000..83cd5bb --- /dev/null +++ b/t/lib/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/lib/t/Eval.pm b/t/lib/t/Eval.pm new file mode 100644 index 0000000..750be48 --- /dev/null +++ b/t/lib/t/Eval.pm @@ -0,0 +1,41 @@ +package t::Eval; + +use warnings; +use strict; + +use Test::More 0.41; + +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/lib/t/Hints.pm b/t/lib/t/Hints.pm new file mode 100644 index 0000000..7461d49 --- /dev/null +++ b/t/lib/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/lib/t/Nest0.pm b/t/lib/t/Nest0.pm new file mode 100644 index 0000000..06e1c44 --- /dev/null +++ b/t/lib/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/lib/t/Nest1.pm b/t/lib/t/Nest1.pm new file mode 100644 index 0000000..8b81696 --- /dev/null +++ b/t/lib/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/lib/t/Simple.pm b/t/lib/t/Simple.pm new file mode 100644 index 0000000..c70eb65 --- /dev/null +++ b/t/lib/t/Simple.pm @@ -0,0 +1,9 @@ +package t::Simple; + +{ use 5.006; } +use warnings; +use strict; + +our $VERSION = 1; + +"t::Simple return"; diff --git a/t/mnf.t b/t/mnf.t new file mode 100644 index 0000000..432ed45 --- /dev/null +++ b/t/mnf.t @@ -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; diff --git a/t/rm.t b/t/rm.t new file mode 100644 index 0000000..fb6885d --- /dev/null +++ b/t/rm.t @@ -0,0 +1,87 @@ +use warnings; +use strict; + +use Test::More tests => 26; + +BEGIN { use_ok "Module::Runtime", qw(require_module); } + +unshift @INC, "./t/lib"; +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..6c251b9 --- /dev/null +++ b/t/taint.t @@ -0,0 +1,33 @@ +#!perl -T +# above line is required to enable taint mode + +use warnings; +use strict; + +BEGIN { + if(eval { eval("1".substr($^X,0,0)) }) { + require Test::More; + Test::More::plan(skip_all => + "tainting not supported on this Perl"); + } +} + +use Test::More tests => 5; + +BEGIN { + use_ok "Module::Runtime", + qw(require_module use_module use_package_optimistically); +} + +unshift @INC, "./t/lib"; +my $tainted_modname = substr($^X, 0, 0) . "t::Simple"; +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; diff --git a/t/um.t b/t/um.t new file mode 100644 index 0000000..f7de48c --- /dev/null +++ b/t/um.t @@ -0,0 +1,112 @@ +use warnings; +use strict; + +use Test::More tests => 37; + +BEGIN { use_ok "Module::Runtime", qw(use_module); } + +unshift @INC, "./t/lib"; +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; diff --git a/t/upo.t b/t/upo.t new file mode 100644 index 0000000..c3385df --- /dev/null +++ b/t/upo.t @@ -0,0 +1,121 @@ +use warnings; +use strict; + +use Test::More tests => 42; + +BEGIN { use_ok "Module::Runtime", qw(use_package_optimistically); } + +unshift @INC, "./t/lib"; +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..246913a --- /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; -- 2.34.1