gv_fetchmeth.t revision 1.1.1.1 
1#!perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 40;
7
8use_ok('XS::APItest');
9
10my $level = -1;
11my @types = map { 'gv_fetchmeth' . $_ } '', qw( _sv _pv _pvn );
12
13sub test { "Sanity check" }
14
15for my $type ( 0..3 ) {
16    is *{
17         XS::APItest::gv_fetchmeth_type(\%::, "test", $type, $level, 0)
18        }{CODE}->(), "Sanity check";
19}
20
21for my $type ( 0..3 ) {
22    my $meth = "gen$type";
23    ok !XS::APItest::gv_fetchmeth_type(\%::, $meth, $type, -1, 0), "With level = -1, $types[$type] returns false.";
24    ok !$::{$meth}, "...and doesn't vivify the glob.";
25
26    ok !XS::APItest::gv_fetchmeth_type(\%::, $meth, $type, 0, 0), "With level = 0, $types[$type] still returns false.";
27    ok $::{$meth}, "...but does vivify the glob.";
28}
29
30{
31    no warnings 'once';
32    *method = sub { 1 };
33}
34
35ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
36ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_sv() is nul-clean";
37is XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_pv() is not nul-clean";
38ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_pvn() is nul-clean";
39
40{
41    use utf8;
42    use open qw( :utf8 :std );
43
44    package ������������;
45
46    sub ������������������ { 1 }
47
48    my $meth_as_octets =
49            "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
50
51    $level = 1;
52    for my $type ( 1..3 ) {
53        ::is XS::APItest::gv_fetchmeth_type(\%������������::, "������������������", $type, $level, 0), "*������������::������������������", "$types[$type] is UTF-8 clean";
54        ::ok !XS::APItest::gv_fetchmeth_type(\%������������::, $meth_as_octets, $type, $level, 0);
55        ::ok !XS::APItest::gv_fetchmeth_type(\%������������::, "method", $type, $level, 0);
56        
57        {
58            no strict 'refs';
59            ::ok !XS::APItest::gv_fetchmeth_type(
60                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
61                            "������������������", $type, $level, 0);
62            ::ok !XS::APItest::gv_fetchmeth_type(
63                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
64                            "method", $type, $level, 0);
65        }
66    }
67}
68