1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
use XS::APItest;
use Test::More tests => 30;
use feature "lexical_subs", "state";
no warnings "experimental::lexical_subs";
is (cv_name(\&foo), 'main::foo', 'cv_name with package sub');
is (cv_name(*{"foo"}{CODE}), 'main::foo',
'cv_name with package sub via glob');
is (cv_name(\*{"foo"}), 'main::foo', 'cv_name with typeglob');
is (cv_name(\"foo"), 'foo', 'cv_name with string');
state sub lex1;
is (cv_name(\&lex1), 'lex1', 'cv_name with lexical sub');
$ret = \cv_name(\&bar, $name);
is $ret, \$name, 'cv_name with package sub returns 2nd argument';
is ($name, 'main::bar', 'retval of cv_name with package sub & 2nd arg');
$ret = \cv_name(*{"bar"}{CODE}, $name);
is $ret, \$name, 'cv_name with package sub via glob returns 2nd argument';
is ($name, 'main::bar', 'retval of cv_name w/pkg sub via glob & 2nd arg');
$ret = \cv_name(\*{"bar"}, $name);
is $ret, \$name, 'cv_name with typeglob returns 2nd argument';
is ($name, 'main::bar', 'retval of cv_name with typeglob & 2nd arg');
$ret = \cv_name(\"bar", $name);
is $ret, \$name, 'cv_name with string returns 2nd argument';
is ($name, 'bar', 'retval of cv_name with string & 2nd arg');
state sub lex2;
$ret = \cv_name(\&lex2, $name);
is $ret, \$name, 'cv_name with lexical sub returns 2nd argument';
is ($name, 'lex2', 'retval of cv_name with lexical sub & 2nd arg');
# nq in test names means CV_NAME_NOTQUAL
is (cv_name(\&foo, undef, 1), 'foo', 'cv_name with package sub (nq)');
is (cv_name(*{"foo"}{CODE}, undef, 1), 'foo',
'cv_name with package sub via glob (nq)');
is (cv_name(\*{"foo"}, undef, 1), 'foo', 'cv_name with typeglob (nq)');
is (cv_name(\"foo", undef, 1), 'foo', 'cv_name with string (nq)');
is (cv_name(\&lex1, undef, 1), 'lex1', 'cv_name with lexical sub (nq)');
$ret = \cv_name(\&bar, $name, 1);
is $ret, \$name, 'cv_name with package sub returns 2nd argument (nq)';
is ($name, 'bar', 'retval of cv_name with package sub & 2nd arg (nq)');
$ret = \cv_name(*{"bar"}{CODE}, $name, 1);
is $ret, \$name, 'cv_name with package sub via glob returns 2nd arg (nq)';
is ($name, 'bar', 'retval of cv_name w/pkg sub via glob & 2nd arg (nq)');
$ret = \cv_name(\*{"bar"}, $name, 1);
is $ret, \$name, 'cv_name with typeglob returns 2nd argument (nq)';
is ($name, 'bar', 'retval of cv_name with typeglob & 2nd arg (nq)');
$ret = \cv_name(\"bar", $name, 1);
is $ret, \$name, 'cv_name with string returns 2nd argument (nq)';
is ($name, 'bar', 'retval of cv_name with string & 2nd arg (nq)');
$ret = \cv_name(\&lex2, $name, 1);
is $ret, \$name, 'cv_name with lexical sub returns 2nd argument (nq)';
is ($name, 'lex2', 'retval of cv_name with lexical sub & 2nd arg (nq)');
|
