t/lib/proxy_constant_subs.t

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