1#!perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 53;
7
8use_ok('XS::APItest');
9
10my $level = -1;
11my @types = map { 'gv_fetchmeth' . $_ . "_autoload" } '', qw( _sv _pv _pvn );
12
13sub test { "Sanity check" }
14
15for my $type ( 0..3 ) {
16    is *{XS::APItest::gv_fetchmeth_autoload_type(
17           \%::, "test", $type, $level, 0
18        )}{CODE}->(), "Sanity check";
19}
20
21{
22    ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "etc", 1, $level, 0), "fails when the glob doesn't exist and AUTOLOAD is undefined,";
23    local *AUTOLOAD = sub { 1 };
24    is XS::APItest::gv_fetchmeth_autoload_type(\%::, "etc", 1, $level, 0), "*main::etc", "..but defining AUTOLOAD makes it succeed.";
25}
26
27for my $type ( 0..3 ) {
28    my $meth = "gen$type";
29    ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth, $type, -1, 0), "With level = -1, $types[$type] returns false.";
30    ok !$::{$meth}, "...and doesn't vivify the glob.";
31
32    ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth, $type, 0, 0), "With level = 0, $types[$type] still returns false.";
33    ok $::{$meth}, "...but does vivify the glob.";
34
35    ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth . $type, $type, $level, 0), "$types[$type] fails when the glob doesn't exist and AUTOLOAD is undefined,";
36    local *AUTOLOAD = sub { 1 };
37    is XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth . $type, $type, $level, 0), "*main::$meth$type", "..but defining AUTOLOAD makes it succeed.";
38}
39
40{
41    no warnings 'once';
42    *method = sub { 1 };
43}
44
45ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
46ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_autoload_sv() is nul-clean";
47is XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_autoload_pv() is not nul-clean";
48ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_autoload_pvn() is nul-clean";
49
50{
51    use utf8;
52    use open qw( :utf8 :std );
53
54    package ｍａｉｎ;
55
56    sub ｍｅｔｈｏｄ { 1 }
57
58    my $meth_as_octets =
59            "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
60
61    $level = -1;
62    for my $type ( 1..3 ) {
63        ::is XS::APItest::gv_fetchmeth_autoload_type(\%ｍａｉｎ::, "ｍｅｔｈｏｄ", $type, $level, 0), "*ｍａｉｎ::ｍｅｔｈｏｄ", "$types[$type] is UTF-8 clean";
64        ::ok !XS::APItest::gv_fetchmeth_autoload_type(\%ｍａｉｎ::, $meth_as_octets, $type, $level, 0);
65        ::ok !XS::APItest::gv_fetchmeth_autoload_type(\%ｍａｉｎ::, "method", $type, $level, 0);
66
67        {
68            no warnings 'once';
69            local *AUTOLOAD = sub { 1 };
70            ::is XS::APItest::gv_fetchmeth_autoload_type(\%ｍａｉｎ::, "ｍｅｔｈｏｄ$type", $type, $level, 0), "*ｍａｉｎ::ｍｅｔｈｏｄ$type", "Autoloading UTF-8 subs works";
71        }
72
73        {
74            no strict 'refs';
75            ::ok !XS::APItest::gv_fetchmeth_autoload_type(
76                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
77                            "ｍｅｔｈｏｄ", $type, $level, 0);
78            ::ok !XS::APItest::gv_fetchmeth_autoload_type(
79                            \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
80                            "method", $type, $level, 0);
81        }
82    }
83}
84