Commit | Line | Data |
---|---|---|
d21989ed BF |
1 | #!perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
499321d3 | 6 | use Test::More tests => 53; |
d21989ed BF |
7 | |
8 | use_ok('XS::APItest'); | |
9 | ||
10 | my $level = -1; | |
11 | my @types = map { 'gv_fetchmeth' . $_ . "_autoload" } '', qw( _sv _pv _pvn ); | |
12 | ||
13 | sub test { "Sanity check" } | |
14 | ||
15 | for my $type ( 0..3 ) { | |
dec33af2 FC |
16 | is *{XS::APItest::gv_fetchmeth_autoload_type( |
17 | \%::, "test", $type, $level, 0 | |
18 | )}{CODE}->(), "Sanity check"; | |
d21989ed BF |
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 | ||
27 | for 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 | ||
45 | ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean"; | |
46 | ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_autoload_sv() is nul-clean"; | |
47 | is XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_autoload_pv() is not nul-clean"; | |
48 | ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_autoload_pvn() is nul-clean"; | |
49 | ||
499321d3 BF |
50 | { |
51 | use utf8; | |
52 | use open qw( :utf8 :std ); | |
53 | ||
54 | package main; | |
55 | ||
56 | sub method { 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(\%main::, "method", $type, $level, 0), "*main::method", "$types[$type] is UTF-8 clean"; | |
64 | ::ok !XS::APItest::gv_fetchmeth_autoload_type(\%main::, $meth_as_octets, $type, $level, 0); | |
65 | ::ok !XS::APItest::gv_fetchmeth_autoload_type(\%main::, "method", $type, $level, 0); | |
66 | ||
67 | { | |
97bae9c5 | 68 | no warnings 'once'; |
499321d3 BF |
69 | local *AUTOLOAD = sub { 1 }; |
70 | ::is XS::APItest::gv_fetchmeth_autoload_type(\%main::, "method$type", $type, $level, 0), "*main::method$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 | "method", $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 | } |