t/op/leaky-magic.t

   1 #!./perl
   2
   3 # This script checks that magic attached to global variables ($!, %SIG,
   4 # etc.) only applies to the globals, and not to similarly-named variables
   5 # in other packages (%Net::DNS::RR::SIG, ${"'Oh no'!"}, etc.).
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     require './test.pl';
  10     @INC = '../lib';
  11 }
  12
  13 # Hack to allow test counts to be specified piecemeal
  14 BEGIN { ++$INC{'tests.pm'} }
  15 sub tests::VERSION { $tests += pop };
  16 plan (tests => $tests);
  17
  18
  19 use tests 2; # First make sure that %! %- %+ do not load extra modules.
  20 map %{"foo::$_"}, qw< ! - + >;
  21 ok !exists $INC{'Errno.pm'}, '$swext::! does not load Errno';
  22 ok !exists $INC{'Tie/Hash/NamedCapture.pm'},
  23   '$foo::+ and $foo::- do not load Tie::Hash::NamedCapture';
  24
  25 use tests 1; # ARGV
  26 fresh_perl_is
  27  '$count=0; ++$count while(<foo::ARGV>); print $count',
  28  '0',
  29   { stdin => 'swext\n' },
  30  '<foo::ARGV> does not iterate through STDIN';
  31
  32 use tests 1; # %SIG
  33 ok !scalar keys %foo::SIG, "%foo::SIG";
  34
  35 use tests 4; # rw ${^LETTERS} variables
  36 for(qw< CHILD_ERROR_NATIVE ENCODING UTF8CACHE WARNING_BITS >) {
  37  my $name = s/./"qq|\\c$&|"/ere;
  38  local $$name = 'swit';
  39
  40  # Bring it into existence first, as defined() sometimes takes shortcuts
  41  ${"foo::$name"};
  42
  43  ok !defined(${"foo::$name"}), "\$foo::^$_";
  44 }
  45
  46 use tests 6; # read-only ${^LETTERS}
  47 for(qw< MATCH PREMATCH POSTMATCH TAINT UNICODE UTF8LOCALE >) {
  48  ok eval { ${"foo::" . s/./"qq|\\c$&|"/ere} = 'prile' }, "\$foo::^$_";
  49 }
  50
  51 use tests 16; # $<digits> and $<single digit> (regexp only, not $0)
  52 for(qw< 1 2 3 4 5 6 7 8 9 324897 237 635 6780 42 14 >) {
  53  ok eval { ${"foo::$_"} = 'prile' }, "\$foo::$_";
  54 }
  55
  56 use tests 5; # read-only single-char scalars
  57 for(qw< & ` ' + ] >) {
  58  ok eval { ${"foo::$_"} = 'twor'}, "\$foo::$_";
  59 }
  60
  61 use tests 14; # rw single-char scalars we can safely modify
  62 {
  63  # $. doesn’t appear magical from Perl-space until a filehandle has been
  64  # read, so we’ll do that right now.
  65  open my $fh, "<", \"freen";
  66  <$fh>;
  67
  68  for(qw< : ? ! - | ^ ~ = % . \ / ; 0 >) {
  69   local $$_ = 'thew';
  70   ${"foo::$_"}; # touch it
  71   ok !defined ${"foo::$_"}, "\$foo::$_";
  72  }
  73 }
  74
  75 use tests 1; # %!
  76 ok scalar keys %{"foo::!"} == 0, '%foo::!';
  77
  78 use tests 4; # [@%][+-]
  79 ok eval { ${"foo::+"}{strat} = 'quin' }, '%foo::+';
  80 ok eval { ${"foo::-"}{strat} = 'quin' }, '%foo::-';
  81 ok eval { ${"foo::+"}[47]    = 'quin' }, '@foo::+';
  82 ok eval { ${"foo::-"}[63]    = 'quin' }, '@foo::-';
  83
  84 use tests 1; # $# - This naughty little thing just warns.
  85 {
  86  my $w = '';
  87  local $SIG{__WARN__} = sub { $w = shift };
  88  eval '${"foo::#"}';
  89  is $w, '', '$foo::#';
  90 }
  91
  92 use tests 11; # rw $^X scalars
  93 for(qw<  C O I L   H A D   W E P T  >) {
  94  my $name = eval "qq|\\c$_|";
  95  local $$name = 'poof'; # we're setting, among other things, $^D, so all
  96                         # characters in here must be valid -D flags
  97  ${"foo::$name"}; # touch
  98  ok !defined ${"foo::$name"}, "\$foo::^$_";
  99 }
 100
 101 use tests 1; # read-only $^X scalars
 102 for(qw< S V >) {
 103  my $name = eval "qq|\\c$_|";
 104  ok eval { ${"foo::$name"} = 'twor'}, "\$foo::^$_";
 105 }
 106
 107 use tests 4; # user/group vars
 108 # These are rw, but setting them is obviously going to make the test much
 109 # more complex than necessary. So, again, we check for definition.
 110 for(qw<   < > ( )   >) {
 111  ${"foo::$_"}; # touch
 112  ok !defined ${"foo::$_"}, "\$foo::$_";
 113 }
 114
 115 use tests 1; # $^N
 116 # This is a cheeky little blighter. It’s not read-only, but setting it does
 117 # nothing. It is undefined by default.
 118 {
 119   my $thing;
 120  "felp" =~ /(.)(?{ $thing = ${"foo::\cN"} })/;
 121   ok !defined $thing, '$foo::^N';
 122 }
 123
 124 # I think that’s it!