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 main; 29 30 sub method { 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(\%main::, "method", $type, 0), "*main::method"; 38 ::ok !XS::APItest::gv_fetchmethod_flags_type(\%main::, $meth_as_octets, $type, 0); 39 ::is XS::APItest::gv_fetchmethod_flags_type(\%main::, "method", $type, 0), "*main::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 "method", $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