1898184e3Ssthen#!perl 2898184e3Ssthen 3898184e3Ssthenuse strict; 4898184e3Ssthenuse warnings; 5898184e3Ssthen 6898184e3Ssthenuse Test::More tests => 24; 7898184e3Ssthen 8898184e3Ssthenuse_ok('XS::APItest'); 9898184e3Ssthen 10898184e3Ssthensub method { 1 } 11898184e3Ssthen 12898184e3Ssthenok !XS::APItest::gv_fetchmethod_flags_type(\%::, "nothing", 1, 0); 13898184e3Ssthen 14898184e3Ssthenfor my $type ( 1..3 ) { 15898184e3Ssthen is XS::APItest::gv_fetchmethod_flags_type(\%::, "method", $type, 0), "*main::method", "Sanity check"; 16898184e3Ssthen} 17898184e3Ssthen 18898184e3Ssthenok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 1, 0), "gv_fetchmethod_flags_sv() is nul-clean"; 19898184e3Ssthenok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 3, 0), "gv_fetchmethod_flags_pvn() is nul-clean"; 20898184e3Ssthen 21898184e3Ssthenok XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 0, 0), "gv_fetchmethod_flags() is not nul-clean"; 22898184e3Ssthenis XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*main::method", "gv_fetchmethod_flags_pv() is not nul-clean"; 23898184e3Ssthen 24898184e3Ssthen{ 25898184e3Ssthen use utf8; 26898184e3Ssthen use open qw( :utf8 :std ); 27898184e3Ssthen 28898184e3Ssthen package ｍａｉｎ; 29898184e3Ssthen 30898184e3Ssthen sub ｍｅｔｈｏｄ { 1 } 31898184e3Ssthen sub method { 1 } 32898184e3Ssthen 33898184e3Ssthen my $meth_as_octets = 34898184e3Ssthen "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204"; 35898184e3Ssthen 36898184e3Ssthen for my $type ( 1..3 ) { 37898184e3Ssthen ::is XS::APItest::gv_fetchmethod_flags_type(\%ｍａｉｎ::, "ｍｅｔｈｏｄ", $type, 0), "*ｍａｉｎ::ｍｅｔｈｏｄ"; 38898184e3Ssthen ::ok !XS::APItest::gv_fetchmethod_flags_type(\%ｍａｉｎ::, $meth_as_octets, $type, 0); 39898184e3Ssthen ::is XS::APItest::gv_fetchmethod_flags_type(\%ｍａｉｎ::, "method", $type, 0), "*ｍａｉｎ::method"; 40898184e3Ssthen 41898184e3Ssthen { 42898184e3Ssthen no strict 'refs'; 43898184e3Ssthen ::ok !XS::APItest::gv_fetchmethod_flags_type( 44898184e3Ssthen \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"}, 45898184e3Ssthen "ｍｅｔｈｏｄ", $type, 0); 46898184e3Ssthen ::ok !XS::APItest::gv_fetchmethod_flags_type( 47898184e3Ssthen \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"}, 48898184e3Ssthen "method", $type, 0); 49898184e3Ssthen } 50898184e3Ssthen } 51898184e3Ssthen} 52*5759b3d2Safresh1 53*5759b3d2Safresh1# [perl #129267] Buffer overrun when argument name ends with colon and 54*5759b3d2Safresh1# there is a colon past the end. This used to segv. 55*5759b3d2Safresh1XS::APItest::gv_fetchmethod_flags_type(\%::, "method:::::", 4, 7); 56*5759b3d2Safresh1 # With type 4, 7 is the length 57