This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
gv.c: Added gv_fetchmeth_(sv|pv|pvn).
[perl5.git] / ext / XS-APItest / t / gv_fetchmeth.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 25;
7
8 use_ok('XS::APItest');
9
10 my $level = -1;
11 my @types = map { 'gv_fetchmeth' . $_ } '', qw( _sv _pv _pvn );
12
13 sub test { "Sanity check" }
14
15 for my $type ( 0..3 ) {
16     is *{XS::APItest::gv_fetchmeth_type(\%::, "test", 1, $level, 0)}{CODE}->(), "Sanity check";
17 }
18
19 for my $type ( 0..3 ) {
20     my $meth = "gen$type";
21     ok !XS::APItest::gv_fetchmeth_type(\%::, $meth, $type, -1, 0), "With level = -1, $types[$type] returns false\ 1";
22     ok !$::{$meth}, "...and doesn't vivify the glob.";
23
24     ok !XS::APItest::gv_fetchmeth_type(\%::, $meth, $type, 0, 0), "With level = 0, $types[$type] still returns false.";
25     ok $::{$meth}, "...but does vivify the glob.";
26 }
27
28 {
29     no warnings 'once';
30     *method = sub { 1 };
31 }
32
33 ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
34 ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_sv() is nul-clean";
35 is XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_pv() is not nul-clean";
36 ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_pvn() is nul-clean";