This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid loading .bs files twice when using XSLoader
[perl5.git] / ext / XS-APItest / t / gv_fetchmeth_autoload.t
CommitLineData
d21989ed
BF
1#!perl
2
3use strict;
4use warnings;
5
499321d3 6use Test::More tests => 53;
d21989ed
BF
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 ) {
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
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
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}