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 ｍａｉｎ;
  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(\%ｍａｉｎ::, $sub = "ｍｅｔｈｏｄ", $type, $method);
  58         *{$glob}{CODE}->( "ｍａｉｎ::" . $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(\%ｍａｉｎ::, $sub = "method", $type, $method);
  60         *{$glob}{CODE}->( "ｍａｉｎ::" . $sub, "$types[$type]() is UTF8-clean when only the stash is in UTF-8");
  61     }
  62 }