Imported Upstream version 0.016 upstream/0.016
authorTizenOpenSource <tizenopensrc@samsung.com>
Wed, 14 Feb 2024 02:27:50 +0000 (11:27 +0900)
committerTizenOpenSource <tizenopensrc@samsung.com>
Wed, 14 Feb 2024 02:27:50 +0000 (11:27 +0900)
30 files changed:
.gitignore [new file with mode: 0644]
Build.PL [new file with mode: 0644]
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
META.json [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
SIGNATURE [new file with mode: 0644]
lib/Module/Runtime.pm [new file with mode: 0644]
t/cmn.t [new file with mode: 0644]
t/dependency.t [new file with mode: 0644]
t/import_error.t [new file with mode: 0644]
t/ivmn.t [new file with mode: 0644]
t/ivms.t [new file with mode: 0644]
t/lib/t/Break.pm [new file with mode: 0644]
t/lib/t/Context.pm [new file with mode: 0644]
t/lib/t/Eval.pm [new file with mode: 0644]
t/lib/t/Hints.pm [new file with mode: 0644]
t/lib/t/Nest0.pm [new file with mode: 0644]
t/lib/t/Nest1.pm [new file with mode: 0644]
t/lib/t/Simple.pm [new file with mode: 0644]
t/mnf.t [new file with mode: 0644]
t/pod_cvg.t [new file with mode: 0644]
t/pod_syn.t [new file with mode: 0644]
t/rm.t [new file with mode: 0644]
t/taint.t [new file with mode: 0644]
t/um.t [new file with mode: 0644]
t/upo.t [new file with mode: 0644]
t/upo_overridden.t [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..3e9a010
--- /dev/null
@@ -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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..94df26c
--- /dev/null
+++ b/META.json
@@ -0,0 +1,62 @@
+{
+   "abstract" : "runtime module handling",
+   "author" : [
+      "Andrew Main (Zefram) <zefram@fysh.org>"
+   ],
+   "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 (file)
index 0000000..23ef523
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,34 @@
+---
+abstract: 'runtime module handling'
+author:
+  - 'Andrew Main (Zefram) <zefram@fysh.org>'
+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 (file)
index 0000000..b691b5c
--- /dev/null
@@ -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 (file)
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) <zefram@fysh.org>
+
+COPYRIGHT
+
+Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014, 2017
+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 (file)
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 (file)
index 0000000..b6c47ba
--- /dev/null
@@ -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<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.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</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.
+
+I<Warning:> 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</tmp>), 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<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, 2017
+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/cmn.t b/t/cmn.t
new file mode 100644 (file)
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 (file)
index 0000000..8c8f9d0
--- /dev/null
@@ -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 (file)
index 0000000..b9b8de3
--- /dev/null
@@ -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 (file)
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 (file)
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 (file)
index 0000000..6214092
--- /dev/null
@@ -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 (file)
index 0000000..83cd5bb
--- /dev/null
@@ -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 (file)
index 0000000..750be48
--- /dev/null
@@ -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 (file)
index 0000000..7461d49
--- /dev/null
@@ -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 (file)
index 0000000..06e1c44
--- /dev/null
@@ -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 (file)
index 0000000..8b81696
--- /dev/null
@@ -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 (file)
index 0000000..c70eb65
--- /dev/null
@@ -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 (file)
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 (file)
index 0000000..64f6c48
--- /dev/null
@@ -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 (file)
index 0000000..6f004ac
--- /dev/null
@@ -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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..246913a
--- /dev/null
@@ -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;