X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F63-uplevel-ctl.t;h=fba2a687d25b178c922376db00b14a9974f96a18;hb=8aa5517d42b61e877ca7e4198f12ab879fa8218b;hp=645d6f89439b2ccf4f943ab28d93675f6d581243;hpb=1da764455f3f82a24aad0881beb01f5e4d3cf858;p=perl%2Fmodules%2FScope-Upper.git

diff --git a/t/63-uplevel-ctl.t b/t/63-uplevel-ctl.t
index 645d6f8..fba2a68 100644
--- a/t/63-uplevel-ctl.t
+++ b/t/63-uplevel-ctl.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3 + (3 + 4 + 4) + (3 + 4 + 4) + 5 + 3*3 + (4 + 7);
+use Test::More tests => 3 + (3 + 4 + 4) + (3 + 4 + 4) + 5 + 3*3 + (4 + 7) + 1;
 
 use Scope::Upper qw<uplevel HERE SUB CALLER>;
 
@@ -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.008002) or "$]" == 5.008006;
+ 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) = @_;
@@ -307,3 +310,20 @@ sub clash {
  is $@, '', "$desc: no exception outside";
  check_depth \&clash, 0, "$desc: depth at the beginning";
 }
+
+# XS
+
+{
+ my $desc = 'exception thrown from XS';
+ local $@;
+ eval {
+  sub {
+   &uplevel(\&uplevel => \1, HERE);
+  }->();
+ };
+ 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 $file line $line/,
+   "$desc: correct error";
+}