diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/Break.pm | 7 | ||||
| -rw-r--r-- | t/Context.pm | 12 | ||||
| -rw-r--r-- | t/Eval.pm | 41 | ||||
| -rw-r--r-- | t/Hints.pm | 17 | ||||
| -rw-r--r-- | t/Nest0.pm | 10 | ||||
| -rw-r--r-- | t/Nest1.pm | 12 | ||||
| -rw-r--r-- | t/Simple.pm | 9 | ||||
| -rw-r--r-- | t/cmn.t | 25 | ||||
| -rw-r--r-- | t/dependency.t | 11 | ||||
| -rw-r--r-- | t/import_error.t | 35 | ||||
| -rw-r--r-- | t/ivmn.t | 49 | ||||
| -rw-r--r-- | t/ivms.t | 82 | ||||
| -rw-r--r-- | t/mnf.t | 13 | ||||
| -rw-r--r-- | t/pod_cvg.t | 9 | ||||
| -rw-r--r-- | t/pod_syn.t | 8 | ||||
| -rw-r--r-- | t/rm.t | 86 | ||||
| -rw-r--r-- | t/taint.t | 24 | ||||
| -rw-r--r-- | t/um.t | 111 | ||||
| -rw-r--r-- | t/upo.t | 120 | ||||
| -rw-r--r-- | t/upo_overridden.t | 19 |
20 files changed, 700 insertions, 0 deletions
diff --git a/t/Break.pm b/t/Break.pm new file mode 100644 index 0000000..6214092 --- /dev/null +++ b/t/Break.pm @@ -0,0 +1,7 @@ +package t::Break; + +{ use 5.006; } +use warnings; +use strict; + +die "broken"; diff --git a/t/Context.pm b/t/Context.pm new file mode 100644 index 0000000..83cd5bb --- /dev/null +++ b/t/Context.pm @@ -0,0 +1,12 @@ +package t::Context; + +{ use 5.006; } +use warnings; +use strict; + +our $VERSION = 1; + +die "t::Context sees array context at file scope" if wantarray; +die "t::Context sees void context at file scope" unless defined wantarray; + +"t::Context return"; diff --git a/t/Eval.pm b/t/Eval.pm new file mode 100644 index 0000000..bbd49e5 --- /dev/null +++ b/t/Eval.pm @@ -0,0 +1,41 @@ +package t::Eval; + +use warnings; +use strict; + +use Test::More; + +sub _ok_no_eval() { + my $lastsub = ""; + my $i = 0; + while(1) { + my @c = caller($i); + unless(@c) { + ok 0; + diag "failed to find main program in stack trace"; + return; + } + my $sub = $c[3]; + if($sub eq "main::eval_test") { + ok 1; + return; + } + my $type = $sub ne "(eval)" ? "subroutine" : + $c[7] ? "require" : + defined($c[6]) ? "string eval" : "block eval"; + if($type =~ /eval/ && !($lastsub eq "t::Eval::BEGIN" && + $type eq "block eval")) { + ok 0; + diag "have $type between module and main program"; + return; + } + $lastsub = $sub; + $i++; + } +} + +BEGIN { _ok_no_eval(); } +_ok_no_eval(); +sub import { _ok_no_eval(); } + +1; diff --git a/t/Hints.pm b/t/Hints.pm new file mode 100644 index 0000000..7461d49 --- /dev/null +++ b/t/Hints.pm @@ -0,0 +1,17 @@ +package t::Hints; + +use warnings; +use strict; + +use Test::More; + +BEGIN { is $^H{"Module::Runtime/test_a"}, undef; } +main::test_runtime_hint_hash "Module::Runtime/test_a", undef; + +sub import { + is $^H{"Module::Runtime/test_a"}, 1; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_b"} = 1; +} + +1; diff --git a/t/Nest0.pm b/t/Nest0.pm new file mode 100644 index 0000000..06e1c44 --- /dev/null +++ b/t/Nest0.pm @@ -0,0 +1,10 @@ +package t::Nest0; + +{ use 5.006; } +use warnings; +use strict; +use t::Nested; + +our $VERSION = 1; + +"t::Nest0 return"; diff --git a/t/Nest1.pm b/t/Nest1.pm new file mode 100644 index 0000000..8b81696 --- /dev/null +++ b/t/Nest1.pm @@ -0,0 +1,12 @@ +package t::Nest1; + +{ use 5.006; } +use warnings; +use strict; +use Module::Runtime qw(require_module); + +our $VERSION = 1; + +require_module("t::Nested"); + +"t::Nest1 return"; diff --git a/t/Simple.pm b/t/Simple.pm new file mode 100644 index 0000000..c70eb65 --- /dev/null +++ b/t/Simple.pm @@ -0,0 +1,9 @@ +package t::Simple; + +{ use 5.006; } +use warnings; +use strict; + +our $VERSION = 1; + +"t::Simple return"; @@ -0,0 +1,25 @@ +use warnings; +use strict; + +use Test::More tests => 17; + +BEGIN { use_ok "Module::Runtime", qw(compose_module_name); } + +is(compose_module_name(undef, "foo"), "foo"); +is(compose_module_name(undef, "foo::bar"), "foo::bar"); +is(compose_module_name(undef, "foo/bar"), "foo::bar"); +is(compose_module_name(undef, "foo/bar/baz"), "foo::bar::baz"); +is(compose_module_name(undef, "/foo"), "foo"); +is(compose_module_name(undef, "/foo::bar"), "foo::bar"); +is(compose_module_name(undef, "::foo/bar"), "foo::bar"); +is(compose_module_name(undef, "::foo/bar/baz"), "foo::bar::baz"); +is(compose_module_name("a::b", "foo"), "a::b::foo"); +is(compose_module_name("a::b", "foo::bar"), "a::b::foo::bar"); +is(compose_module_name("a::b", "foo/bar"), "a::b::foo::bar"); +is(compose_module_name("a::b", "foo/bar/baz"), "a::b::foo::bar::baz"); +is(compose_module_name("a::b", "/foo"), "foo"); +is(compose_module_name("a::b", "/foo::bar"), "foo::bar"); +is(compose_module_name("a::b", "::foo/bar"), "foo::bar"); +is(compose_module_name("a::b", "::foo/bar/baz"), "foo::bar::baz"); + +1; diff --git a/t/dependency.t b/t/dependency.t new file mode 100644 index 0000000..8c8f9d0 --- /dev/null +++ b/t/dependency.t @@ -0,0 +1,11 @@ +# This test checks that M:R doesn't load any other modules. Hence this +# script cannot itself use warnings, Test::More, or any other module. + +BEGIN { print "1..1\n"; } +our(%preloaded, @extraloaded); +BEGIN { %preloaded = %INC; } +use Module::Runtime qw(require_module); +BEGIN { @extraloaded = sort grep { !exists($preloaded{$_}) } keys %INC; } +print join(" ", @extraloaded) eq "Module/Runtime.pm" ? "" : "not ", "ok 1\n"; + +1; diff --git a/t/import_error.t b/t/import_error.t new file mode 100644 index 0000000..b9b8de3 --- /dev/null +++ b/t/import_error.t @@ -0,0 +1,35 @@ +use warnings; +use strict; + +use Test::More tests => 3; + +eval q{#line 11 "test_eval" + use Module::Runtime qw(foo); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 11/ if "$]" < 5.006001; +like $@, qr/\A + \"foo\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 11.\n +/x; + +eval q{#line 22 "test_eval" + use Module::Runtime qw(require_module.1); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 22/ if "$]" < 5.006001; +like $@, qr/\A + \"require_module.1\"\ is\ not\ exported + \ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 22.\n +/x; + +eval q{#line 33 "test_eval" + use Module::Runtime qw(foo require_module bar); +}; +$@ =~ s/\(eval [0-9]+\) line 2/test_eval line 33/ if "$]" < 5.006001; +like $@, qr/\A + \"foo\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + \"bar\"\ is\ not\ exported\ by\ the\ Module::Runtime\ module\n + Can't\ continue\ after\ import\ errors\ at\ test_eval\ line\ 33.\n +/x; + +1; diff --git a/t/ivmn.t b/t/ivmn.t new file mode 100644 index 0000000..c252e7f --- /dev/null +++ b/t/ivmn.t @@ -0,0 +1,49 @@ +use warnings; +use strict; + +use Test::More tests => 47; + +BEGIN { use_ok "Module::Runtime", qw( + $module_name_rx is_module_name is_valid_module_name check_module_name +); } + +ok \&is_valid_module_name == \&is_module_name; + +foreach my $name ( + undef, + *STDOUT, + \"Foo", + [], + {}, + sub{}, +) { + ok(!is_module_name($name), "non-string is bad (function)"); + eval { check_module_name($name) }; isnt $@, ""; +} + +foreach my $name (qw( + Foo + foo::bar + IO::File + foo::123::x_0 + _ +)) { + ok(is_module_name($name), "`$name' is good (function)"); + eval { check_module_name($name) }; is $@, ""; + ok($name =~ /\A$module_name_rx\z/, "`$name' is good (regexp)"); +} + +foreach my $name (qw( + foo'bar + foo/bar + IO:: + 1foo::bar + ::foo + foo::::bar +)) { + ok(!is_module_name($name), "`$name' is bad (function)"); + eval { check_module_name($name) }; isnt $@, ""; + ok($name !~ /\A$module_name_rx\z/, "`$name' is bad (regexp)"); +} + +1; diff --git a/t/ivms.t b/t/ivms.t new file mode 100644 index 0000000..0c92890 --- /dev/null +++ b/t/ivms.t @@ -0,0 +1,82 @@ +use warnings; +use strict; + +use Test::More tests => 140; + +BEGIN { use_ok "Module::Runtime", qw( + $top_module_spec_rx $sub_module_spec_rx + is_module_spec is_valid_module_spec check_module_spec +); } + +ok \&is_valid_module_spec == \&is_module_spec; + +foreach my $spec ( + undef, + *STDOUT, + \"Foo", + [], + {}, + sub{}, +) { + ok(!is_module_spec(0, $spec), "non-string is bad (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok(!is_module_spec(1, $spec), "non-string is bad (function)"); + eval { check_module_spec(1, $spec) }; isnt $@, ""; +} + +foreach my $spec (qw( + Foo + foo::bar + foo::123::x_0 + foo/bar + foo/123::x_0 + foo::123/x_0 + foo/123/x_0 + /Foo + /foo/bar + ::foo/bar +)) { + ok(is_module_spec(0, $spec), "`$spec' is always good (function)"); + eval { check_module_spec(0, $spec) }; is $@, ""; + ok($spec =~ qr/\A$top_module_spec_rx\z/, + "`$spec' is always good (regexp)"); + ok(is_module_spec(1, $spec), "`$spec' is always good (function)"); + eval { check_module_spec(1, $spec) }; is $@, ""; + ok($spec =~ qr/\A$sub_module_spec_rx\z/, + "`$spec' is always good (regexp)"); +} + +foreach my $spec (qw( + foo'bar + IO:: + foo::::bar + /foo/ + /1foo + ::foo:: + ::1foo +)) { + ok(!is_module_spec(0, $spec), "`$spec' is always bad (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$top_module_spec_rx\z/, + "`$spec' is always bad (regexp)"); + ok(!is_module_spec(1, $spec), "`$spec' is always bad (function)"); + eval { check_module_spec(1, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$sub_module_spec_rx\z/, + "`$spec' is always bad (regexp)"); +} + +foreach my $spec (qw( + 1foo + 0/1 +)) { + ok(!is_module_spec(0, $spec), "`$spec' needs a prefix (function)"); + eval { check_module_spec(0, $spec) }; isnt $@, ""; + ok($spec !~ qr/\A$top_module_spec_rx\z/, + "`$spec' needs a prefix (regexp)"); + ok(is_module_spec(1, $spec), "`$spec' needs a prefix (function)"); + eval { check_module_spec(1, $spec) }; is $@, ""; + ok($spec =~ qr/\A$sub_module_spec_rx\z/, + "`$spec' needs a prefix (regexp)"); +} + +1; @@ -0,0 +1,13 @@ +use warnings; +use strict; + +use Test::More tests => 5; + +BEGIN { use_ok "Module::Runtime", qw(module_notional_filename); } + +is module_notional_filename("Test::More"), "Test/More.pm"; +is module_notional_filename("Test::More::Widgets"), "Test/More/Widgets.pm"; +is module_notional_filename("Foo::0Bar::Baz"), "Foo/0Bar/Baz.pm"; +is module_notional_filename("Foo"), "Foo.pm"; + +1; diff --git a/t/pod_cvg.t b/t/pod_cvg.t new file mode 100644 index 0000000..64f6c48 --- /dev/null +++ b/t/pod_cvg.t @@ -0,0 +1,9 @@ +use warnings; +use strict; + +use Test::More; +plan skip_all => "Test::Pod::Coverage not available" + unless eval "use Test::Pod::Coverage; 1"; +Test::Pod::Coverage::all_pod_coverage_ok(); + +1; diff --git a/t/pod_syn.t b/t/pod_syn.t new file mode 100644 index 0000000..6f004ac --- /dev/null +++ b/t/pod_syn.t @@ -0,0 +1,8 @@ +use warnings; +use strict; + +use Test::More; +plan skip_all => "Test::Pod not available" unless eval "use Test::Pod 1.00; 1"; +Test::Pod::all_pod_files_ok(); + +1; @@ -0,0 +1,86 @@ +use warnings; +use strict; + +use Test::More tests => 26; + +BEGIN { use_ok "Module::Runtime", qw(require_module); } + +my($result, $err); + +sub test_require_module($) { + my($name) = @_; + $result = eval { require_module($name) }; + $err = $@; +} + +# a module that doesn't exist +test_require_module("t::NotExist"); +like($err, qr/^Can't locate /); + +# a module that's already loaded +test_require_module("Test::More"); +is($err, ""); +is($result, 1); + +# a module that we'll load now +test_require_module("t::Simple"); +is($err, ""); +is($result, "t::Simple return"); + +# re-requiring the module that we just loaded +test_require_module("t::Simple"); +is($err, ""); +is($result, 1); + +# module file scope sees scalar context regardless of calling context +eval { require_module("t::Context"); 1 }; +is $@, ""; + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + require_module("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { require_module("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { require_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { require_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# no extra eval frame +SKIP: { + skip "core bug makes this test crash", 2 if "$]" < 5.006001; + sub eval_test () { require_module("t::Eval") } + eval_test(); +} + +1; diff --git a/t/taint.t b/t/taint.t new file mode 100644 index 0000000..fd6e44c --- /dev/null +++ b/t/taint.t @@ -0,0 +1,24 @@ +#!perl -T +# above line is required to enable taint mode + +use warnings; +use strict; + +use Test::More tests => 5; + +BEGIN { + use_ok "Module::Runtime", + qw(require_module use_module use_package_optimistically); +} + +my $tainted_modname = substr($ENV{PATH}, 0, 0) . "Module::Runtime"; +eval { require_module($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { use_module($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { use_package_optimistically($tainted_modname) }; +like $@, qr/\AInsecure dependency /; +eval { require_module("Module::Runtime") }; +is $@, ""; + +1; @@ -0,0 +1,111 @@ +use warnings; +use strict; + +use Test::More tests => 37; + +BEGIN { use_ok "Module::Runtime", qw(use_module); } + +my $result; + +# a module that doesn't exist +$result = eval { use_module("t::NotExist") }; +like($@, qr/^Can't locate /); + +# a module that's already loaded +$result = eval { use_module("Test::More") }; +is($@, ""); +is($result, "Test::More"); + +# a module that we'll load now +$result = eval { use_module("t::Simple") }; +is($@, ""); +is($result, "t::Simple"); + +# re-requiring the module that we just loaded +$result = eval { use_module("t::Simple") }; +is($@, ""); +is($result, "t::Simple"); + +# module file scope sees scalar context regardless of calling context +$result = eval { use_module("t::Context"); 1 }; +is $@, ""; + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + use_module("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { use_module("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { use_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { use_module("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# no extra eval frame +SKIP: { + skip "core bug makes this test crash", 2 if "$]" < 5.006001; + sub eval_test () { use_module("t::Eval") } + eval_test(); +} + +# successful version check +$result = eval { use_module("Module::Runtime", 0.001) }; +is($@, ""); +is($result, "Module::Runtime"); + +# failing version check +$result = eval { use_module("Module::Runtime", 999) }; +like($@, qr/^Module::Runtime version /); + +# make sure any version argument gets passed through +my @version_calls; +sub t::HasVersion::VERSION { + push @version_calls, [@_]; +} +$INC{"t/HasVersion.pm"} = 1; +eval { use_module("t::HasVersion") }; +is $@, ""; +is_deeply \@version_calls, []; +@version_calls = (); +eval { use_module("t::HasVersion", 2) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",2]]; +@version_calls = (); +eval { use_module("t::HasVersion", "wibble") }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion","wibble"]]; +@version_calls = (); +eval { use_module("t::HasVersion", undef) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",undef]]; + +1; @@ -0,0 +1,120 @@ +use warnings; +use strict; + +use Test::More tests => 42; + +BEGIN { use_ok "Module::Runtime", qw(use_package_optimistically); } + +my $result; + +# a module that doesn't exist +$result = eval { use_package_optimistically("t::NotExist") }; +is $@, ""; +is $result, "t::NotExist"; + +# a module that's already loaded +$result = eval { use_package_optimistically("Test::More") }; +is $@, ""; +is $result, "Test::More"; + +# a module that we'll load now +$result = eval { use_package_optimistically("t::Simple") }; +is $@, ""; +is $result, "t::Simple"; +no strict "refs"; +ok defined(${"t::Simple::VERSION"}); + +# lexical hints don't leak through +my $have_runtime_hint_hash = "$]" >= 5.009004; +sub test_runtime_hint_hash($$) { + SKIP: { + skip "no runtime hint hash", 1 unless $have_runtime_hint_hash; + is +((caller(0))[10] || {})->{$_[0]}, $_[1]; + } +} +SKIP: { + skip "core bug makes this test crash", 13 + if "$]" >= 5.008 && "$]" < 5.008004; + skip "can't work around hint leakage in pure Perl", 13 + if "$]" >= 5.009004 && "$]" < 5.010001; + $^H |= 0x20000 if "$]" < 5.009004; + $^H{"Module::Runtime/test_a"} = 1; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + use_package_optimistically("t::Hints"); + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, undef; + t::Hints->import; + is $^H{"Module::Runtime/test_a"}, 1; + is $^H{"Module::Runtime/test_b"}, 1; + eval q{ + BEGIN { $^H |= 0x20000; $^H{foo} = 1; } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + BEGIN { use_package_optimistically("Math::BigInt"); } + BEGIN { is $^H{foo}, 1; } + main::test_runtime_hint_hash("foo", 1); + 1; + }; die $@ unless $@ eq ""; +} + +# broken module is visibly broken when re-required +eval { use_package_optimistically("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; +eval { use_package_optimistically("t::Break") }; +like $@, qr/\A(?:broken |Attempt to reload )/; + +# module broken by virtue of trying to non-optimistically load a +# non-existent module via "use" +eval { use_package_optimistically("t::Nest0") }; +like $@, qr/\ACan't locate /; +eval { use_package_optimistically("t::Nest0") }; +like $@, qr/\A(?:Can't locate |Attempt to reload )/; + +# module broken by virtue of trying to non-optimistically load a +# non-existent module via require_module() +eval { use_package_optimistically("t::Nest1") }; +like $@, qr/\ACan't locate /; +eval { use_package_optimistically("t::Nest1") }; +like $@, qr/\A(?:Can't locate |Attempt to reload )/; + +# successful version check +$result = eval { use_package_optimistically("Module::Runtime", 0.001) }; +is $@, ""; +is $result, "Module::Runtime"; + +# failing version check +$result = eval { use_package_optimistically("Module::Runtime", 999) }; +like $@, qr/^Module::Runtime version /; + +# even load module if $VERSION already set, unlike older behaviour +$t::Context::VERSION = undef; +$result = eval { use_package_optimistically("t::Context") }; +is $@, ""; +is $result, "t::Context"; +ok defined($t::Context::VERSION); +ok $INC{"t/Context.pm"}; + +# make sure any version argument gets passed through +my @version_calls; +sub t::HasVersion::VERSION { + push @version_calls, [@_]; +} +$INC{"t/HasVersion.pm"} = 1; +eval { use_package_optimistically("t::HasVersion") }; +is $@, ""; +is_deeply \@version_calls, []; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", 2) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",2]]; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", "wibble") }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion","wibble"]]; +@version_calls = (); +eval { use_package_optimistically("t::HasVersion", undef) }; +is $@, ""; +is_deeply \@version_calls, [["t::HasVersion",undef]]; + +1; diff --git a/t/upo_overridden.t b/t/upo_overridden.t new file mode 100644 index 0000000..2cd9cc1 --- /dev/null +++ b/t/upo_overridden.t @@ -0,0 +1,19 @@ +use warnings; +use strict; + +if("$]" < 5.007002) { + require Test::More; + Test::More::plan(skip_all => + "require override can't work acceptably on this perl"); +} elsif("$]" >= 5.007002 && "$]" < 5.008009) { + require Test::More; + Test::More::plan(skip_all => + "require override can't be dodged on this perl"); +} + +no warnings "once"; +*CORE::GLOBAL::require = sub { require $_[0] }; + +do "t/upo.t" or die $@ || $!; + +1; |