t/lib/proxy_constant_subs.t

   1 my @symbols;
   2 BEGIN {
   3     chdir 't';
   4     @INC = '../lib';
   5     require Config;
   6     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
   7         print "1..0 # Skip -- Perl configured without B module\n";
   8         exit 0;
   9     }
  10     if ($Config::Config{'extensions'} !~ /\bFcntl\b/) {
  11         print "1..0 # Skip -- Perl configured without Fcntl\n";
  12         exit 0;
  13     }
  14     # S_IFMT is a real subroutine, and acts as control
  15     # SEEK_SET is a proxy constant subroutine.
  16     @symbols = qw(S_IFMT SEEK_SET);
  17 }
  18
  19 use strict;
  20 use warnings;
  21 use Test::More tests => 4 * @symbols;
  22 use B qw(svref_2object GVf_IMPORTED_CV);
  23 use Fcntl @symbols;
  24
  25 # GVf_IMPORTED_CV should not be set on the original, but should be set on the
  26 # imported GV.
  27
  28 foreach my $symbol (@symbols) {
  29     my ($ps, $ms);
  30     {
  31         no strict 'refs';
  32         $ps = svref_2object(\*{"Fcntl::$symbol"});
  33         $ms = svref_2object(\*{"::$symbol"});
  34     }
  35     isa_ok($ps, 'B::GV');
  36     is($ps->GvFLAGS() & GVf_IMPORTED_CV, 0,
  37        "GVf_IMPORTED_CV not set on original");
  38     isa_ok($ms, 'B::GV');
  39     is($ms->GvFLAGS() & GVf_IMPORTED_CV, GVf_IMPORTED_CV,
  40        "GVf_IMPORTED_CV set on imported GV");
  41 }