From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 13 Feb 2013 14:11:16 +0000 (+0100)
Subject: Test that call checkers are copied with actual closures.
X-Git-Tag: upstream/5.20.0~4033
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=de19dead5ea4c0494ce36818d909a44f25573257;p=platform%2Fupstream%2Fperl.git

Test that call checkers are copied with actual closures.

This relates to the tests added by commit 09fb282d08ec6c01.
---

diff --git a/ext/XS-APItest/t/call_checker.t b/ext/XS-APItest/t/call_checker.t
index b01323a..377cb74 100644
--- a/ext/XS-APItest/t/call_checker.t
+++ b/ext/XS-APItest/t/call_checker.t
@@ -1,6 +1,6 @@
 use warnings;
 use strict;
-use Test::More tests => 70;
+use Test::More tests => 76;
 
 use XS::APItest;
 
@@ -178,4 +178,32 @@ is $@, "";
 is_deeply $foo_got, [ 2, qw(a b c) ], 'undef clears call checkers';
 is $foo_ret, "z";
 
+my %got;
+
+sub g {
+    my $name = shift;
+    my $sub = sub ($\@) {
+	$got{$name} = [ @_ ];
+	return $name;
+    };
+    cv_set_call_checker_scalars($sub);
+    return $sub;
+}
+
+BEGIN {
+    *whack = g("whack");
+    *glurp = g("glurp");
+}
+
+%got = ();
+my $whack_ret = whack(@b, @c);
+is $@, "";
+is_deeply $got{whack}, [ 2, 3 ];
+is $whack_ret, "whack";
+
+my $glurp_ret = glurp(@b, @c);
+is $@, "";
+is_deeply $got{glurp}, [ 2, 3 ];
+is $glurp_ret, "glurp";
+
 1;