ext/XS-APItest/t/gv_fetchmeth.t

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