t/lib/proxy_constant_subs.t

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