X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F63-uplevel-ctl.t;h=fba2a687d25b178c922376db00b14a9974f96a18;hb=e7846e7f6fded4c4a3139054c5206c1480711867;hp=fda4410f8791538e44e3e030b71f069acd43c713;hpb=2f468390ee816db81380ced997a5b75660c01d46;p=perl%2Fmodules%2FScope-Upper.git diff --git a/t/63-uplevel-ctl.t b/t/63-uplevel-ctl.t index fda4410..fba2a68 100644 --- a/t/63-uplevel-ctl.t +++ b/t/63-uplevel-ctl.t @@ -77,7 +77,8 @@ is do { local $@; eval { depth() } }, 1, 'check eval block depth'; }->(); fail "$desc: not reached 2"; ]; - like $@, qr/^onion at \(eval \d+\) line 8/, "$desc: correct exception"; + my $loc = $^P ? "[$0:" . (__LINE__-14) . ']' : ''; + like $@, qr/^onion at \(eval \d+\)\Q$loc\E line 8/, "$desc: correct exception"; } { @@ -145,13 +146,15 @@ is do { local $@; eval { depth() } }, 1, 'check eval block depth'; }->(); fail "$desc: not reached 3"; }; - like $@, qr/^ravioli at \(eval \d+\) line 7/, "$desc: correct exception"; + my $loc = $^P ? "[$0:" . (__LINE__-15) . ']' : ''; + like $@, qr/^ravioli at \(eval \d+\)\Q$loc\E line 7/, + "$desc: correct exception"; } our $hurp; SKIP: { - skip "Causes failures during global destruction on perl 5.8.[0126]" => 5 - if ("$]" >= 5.008 and "$]" <= 5.008_002) or "$]" == 5.008_006; + skip "Causes failures during global destruction on perl 5.8.[0-6]" => 5 + if "$]" >= 5.008 and "$]" <= 5.008_006; my $desc = 'exception with an eval and a local $@ in between'; local $hurp = 'durp'; local $@; @@ -223,7 +226,7 @@ SKIP: { like $@, qr/^tomato at \Q$0\E line $line/, "$desc (third): correct exception"; } -my $has_B = do { local $@; eval 'require B; 1' }; +my $has_B = do { local $@; eval { require B; 1 } }; sub check_depth { my ($code, $expected, $desc) = @_; @@ -318,8 +321,9 @@ sub clash { &uplevel(\&uplevel => \1, HERE); }->(); }; - my $line = __LINE__-2; # The error happens at the target frame. + my $line = $^P ? '\d+' : __LINE__-2; # The error happens at the target frame. + my $file = $^P ? '\S+' : quotemeta $0; like $@, - qr/^First argument to uplevel must be a code reference at \Q$0\E line $line/, + qr/^First argument to uplevel must be a code reference at $file line $line/, "$desc: correct error"; }