]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blobdiff - t/63-uplevel-ctl.t
Fix uplevel() recalling into an XSUB
[perl/modules/Scope-Upper.git] / t / 63-uplevel-ctl.t
index 645d6f89439b2ccf4f943ab28d93675f6d581243..4f031bce414ef403fa3127dab8280810fc4129a5 100644 (file)
@@ -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>;
 
@@ -307,3 +307,19 @@ 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 = __LINE__-2; # The error happens at the target frame.
+ like $@,
+   qr/^First argument to uplevel must be a code reference at \Q$0\E line $line/,
+   "$desc: correct error";
+}