This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta.pod: tweak -Dusedefaultstrict text
[perl5.git] / ext / XS-APItest / t / gv_autoload4.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 31;
7
8 use_ok('XS::APItest');
9
10 my $method = 0;
11 my @types  = map { 'gv_autoload' . $_ } qw( 4 _sv _pv _pvn );
12
13 sub AUTOLOAD {
14     our $AUTOLOAD;
15     my ($subname, $message) = @_;
16     is $subname, $AUTOLOAD, $message;
17 }
18
19 my $sub = "nothing";
20
21 ok my $glob = XS::APItest::gv_autoload_type(\%::, $sub, 1, $method);
22 *{$glob}{CODE}->( __PACKAGE__ . "::" . $sub, '$AUTOLOAD set correctly' );
23
24 $sub = "some_sub";
25 for my $type ( 0..3 ) {
26     is $glob = XS::APItest::gv_autoload_type(\%::, $sub, $type, $method), "*main::AUTOLOAD", "*main::AUTOLOAD if autoload is true in $types[$type].";
27     *{$glob}{CODE}->( __PACKAGE__ . "::" . $sub, '$AUTOLOAD set correctly' );
28 }
29
30 $sub = "method\0not quite!";
31
32 ok $glob = XS::APItest::gv_autoload_type(\%::, $sub, 0, $method);
33 *{$glob}{CODE}->( __PACKAGE__ . "::" . $sub, "gv_autoload4() is nul-clean");
34
35 ok $glob = XS::APItest::gv_autoload_type(\%::, $sub, 1, $method);
36 *{$glob}{CODE}->( __PACKAGE__ . "::" . $sub, "gv_autoload_sv() is nul-clean");
37
38 ok $glob = XS::APItest::gv_autoload_type(\%::, $sub, 2, $method);
39 *{$glob}{CODE}->( __PACKAGE__ . "::" . ($sub =~ s/\0.*//r), "gv_autoload_pv() is not nul-clean");
40
41 ok $glob = XS::APItest::gv_autoload_type(\%::, $sub, 3, $method);
42 *{$glob}{CODE}->( __PACKAGE__ . "::" . $sub, "gv_autoload_pvn() is nul-clean");
43
44 {
45     use utf8;
46     use open qw( :utf8 :std );
47
48     package main;
49
50     sub AUTOLOAD {
51         our $AUTOLOAD;
52         my ($subname, $message) = @_;
53         ::is $subname, $AUTOLOAD, $message;
54     }
55
56     for my $type ( 1..3 ) {
57         ::ok $glob = XS::APItest::gv_autoload_type(\%main::, $sub = "method", $type, $method);
58         *{$glob}{CODE}->( "main::" . $sub, "$types[$type]() is UTF8-clean when both the stash and the sub are in UTF-8");
59         ::ok $glob = XS::APItest::gv_autoload_type(\%main::, $sub = "method", $type, $method);
60         *{$glob}{CODE}->( "main::" . $sub, "$types[$type]() is UTF8-clean when only the stash is in UTF-8");
61     }
62 }