1#!perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 24;
7
8use_ok('XS::APItest');
9
10sub method { 1 }
11
12ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "nothing", 1, 0);
13
14for my $type ( 1..3 ) {
15    is XS::APItest::gv_fetchmethod_flags_type(\%::, "method", $type, 0), "*main::method", "Sanity check";
16}
17
18ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 1, 0), "gv_fetchmethod_flags_sv() is nul-clean";
19ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 3, 0), "gv_fetchmethod_flags_pvn() is nul-clean";
20
21ok XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 0, 0), "gv_fetchmethod_flags() is not nul-clean";
22is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*main::method", "gv_fetchmethod_flags_pv() is not nul-clean";
23
24{
25    use utf8;
26    use open qw( :utf8 :std );
27
28    package ������������;
29    
30    sub ������������������ { 1 }
31    sub method { 1 }
32
33    my $meth_as_octets =
34            "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
35
36    for my $type ( 1..3 ) {
37        ::is XS::APItest::gv_fetchmethod_flags_type(\%������������::, "������������������", $type, 0), "*������������::������������������";
38        ::ok !XS::APItest::gv_fetchmethod_flags_type(\%������������::, $meth_as_octets, $type, 0);
39        ::is XS::APItest::gv_fetchmethod_flags_type(\%������������::, "method", $type, 0), "*������������::method";
40        
41        {
42            no strict 'refs';
43            ::ok !XS::APItest::gv_fetchmethod_flags_type(
44                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
45                            "������������������", $type, 0);
46            ::ok !XS::APItest::gv_fetchmethod_flags_type(
47                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
48                            "method", $type, 0);
49        }
50    }
51}
52
53# [perl #129267] Buffer overrun when argument name ends with colon and
54#                there is a colon past the end.  This used to segv.
55XS::APItest::gv_fetchmethod_flags_type(\%::, "method:::::", 4, 7);
56                                             # With type 4, 7 is the length
57