From d008afd04ff1717d90f97df572189cdb8cb900e7 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Sat, 7 Jan 2012 15:22:03 -0600 Subject: handle require VERSION correctly --- lib/circular/require.pm | 35 ++++++++++++++++++++++------------- t/version.t | 48 ++++++++++++++++++++++++++++++++++++++++++++++-- t/version/Foo.pm | 3 --- 3 files changed, 68 insertions(+), 18 deletions(-) delete mode 100644 t/version/Foo.pm diff --git a/lib/circular/require.pm b/lib/circular/require.pm index 85deeef..b6a5c95 100644 --- a/lib/circular/require.pm +++ b/lib/circular/require.pm @@ -106,25 +106,34 @@ sub _require { } } } + local $loaded_from{$string_file} = $previous_file; local $previous_file = $string_file; - my $ret; - # ugh, base.pm checks against the regex - # /^Can't locate .*? at \(eval / to see if it should suppress the error - # but we're not in an eval anymore - # fake it up so that this looks the same - if (defined((caller(1))[6])) { + + return $saved_require_hook->($file) + if $saved_require_hook; + + if (ref(\$file) eq 'VSTRING') { + # require 5.8.1 + return eval sprintf("CORE::require %vd", $file) || die $@; + } + elsif (!(B::svref_2object(\$file)->FLAGS & B::SVf_POK)) { + # require 5.008 + # note: we are careful above to never use $file in any potential string + # contexts - this is what the $string_file variable is for + return eval "CORE::require $file" || die $@; + } + elsif (defined((caller(1))[6])) { + # ugh, base.pm checks against the regex + # /^Can't locate .*? at \(eval / to see if it should suppress the error + # but we're not in an eval anymore + # fake it up so that this looks the same my $str = B::perlstring($file); - $ret = $saved_require_hook - ? $saved_require_hook->($file) - : (eval "CORE::require($str)" || die $@); + return eval "CORE::require($str)" || die $@; } else { - $ret = $saved_require_hook - ? $saved_require_hook->($file) - : CORE::require($file); + return CORE::require($file); } - return $ret; } sub import { diff --git a/t/version.t b/t/version.t index ad5d2ea..2c8e37b 100644 --- a/t/version.t +++ b/t/version.t @@ -1,10 +1,54 @@ #!/usr/bin/env perl use strict; use warnings; -use lib 't/version'; use Test::More; +my %tests; +BEGIN { + %tests = ( + '5.008001' => undef, + 'v5.8.1' => undef, + '5.8.1' => undef, + '6.008001' => qr/^Perl v6\.8\.1 required/, + 'v6.8.1' => qr/^Perl v6\.8\.1 required/, + '6.8.1' => qr/^Perl v6\.8\.1 required/, + 'vFoo' => qr/^Can't locate vFoo\.pm in \@INC/, + 'v101' => qr/^Perl v101\.0\.0 required/, + '"v101"' => qr/^Can't locate v101 in \@INC/, + '"5.8.1"' => qr/^Can't locate 5\.8\.1 in \@INC/, + '"5.008"' => qr/^Can't locate 5\.008 in \@INC/, + ); +} + +sub run_tests { + my $when = shift; + for my $test (keys %tests) { + for my $require (qw(use require)) { + # use STRING is not valid syntax + next if $require eq 'use' && $test =~ /^"/; + + eval "$require $test"; + my $err = $@; + if (defined($tests{$test})) { + like($err, $tests{$test}, + "$require $test threw the correct error $when"); + } + else { + is($err, '', + "$require $test succeeded $when"); + } + } + } +} + +BEGIN { run_tests 'before load' } + no circular::require; -use_ok('Foo'); + +run_tests 'when enabled'; + +use circular::require; + +run_tests 'when disabled'; done_testing; diff --git a/t/version/Foo.pm b/t/version/Foo.pm deleted file mode 100644 index 67de8a7..0000000 --- a/t/version/Foo.pm +++ /dev/null @@ -1,3 +0,0 @@ -package Foo; -use 5.008001; -1; -- cgit v1.2.3-54-g00ecf