t/lib/proxy_constant_subs.t

   1 my @symbols;
   2 BEGIN {
   3     require './test.pl';
   4     skip_all_without_dynamic_extension($_) foreach qw(B Fcntl);
   5     # S_IFMT is a real subroutine, and acts as control
   6     # SEEK_SET is a proxy constant subroutine.
   7     @symbols = qw(S_IFMT SEEK_SET);
   8 }
   9
  10 use strict;
  11 use warnings;
  12 plan(4 * @symbols);
  13 use B qw(svref_2object GVf_IMPORTED_CV);
  14 use Fcntl @symbols;
  15
  16 # GVf_IMPORTED_CV should not be set on the original, but should be set on the
  17 # imported GV.
  18
  19 foreach my $symbol (@symbols) {
  20     my ($ps, $ms);
  21     {
  22         no strict 'refs';
  23         $ps = svref_2object(\*{"Fcntl::$symbol"});
  24         $ms = svref_2object(\*{"::$symbol"});
  25     }
  26     object_ok($ps, 'B::GV');
  27     is($ps->GvFLAGS() & GVf_IMPORTED_CV, 0,
  28        "GVf_IMPORTED_CV not set on original");
  29     object_ok($ms, 'B::GV');
  30     is($ms->GvFLAGS() & GVf_IMPORTED_CV, GVf_IMPORTED_CV,
  31        "GVf_IMPORTED_CV set on imported GV");
  32 }