lib/Symbol.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Test::More tests => 19;
   9
  10 BEGIN { $_ = 'foo'; }  # because Symbol used to clobber $_
  11
  12 use Symbol;
  13
  14 ok( $_ eq 'foo', 'check $_ clobbering' );
  15
  16
  17 # First test gensym()
  18 $sym1 = gensym;
  19 ok( ref($sym1) eq 'GLOB', 'gensym() returns a GLOB' );
  20
  21 $sym2 = gensym;
  22
  23 ok( $sym1 ne $sym2, 'gensym() returns a different GLOB' );
  24
  25 ungensym $sym1;
  26
  27 $sym1 = $sym2 = undef;
  28
  29 # Test geniosym()
  30
  31 use Symbol qw(geniosym);
  32
  33 $sym1 = geniosym;
  34 like( $sym1, qr/=IO\(/, 'got an IO ref' );
  35
  36 $FOO = 'Eymascalar';
  37 *FOO = $sym1;
  38
  39 is( $sym1, *FOO{IO}, 'assigns into glob OK' );
  40
  41 is( $FOO, 'Eymascalar', 'leaves scalar alone' );
  42
  43 {
  44     local $^W=1;                # 5.005 compat.
  45     my $warn;
  46     local $SIG{__WARN__} = sub { $warn .= "@_" };
  47     readline FOO;
  48     like( $warn, qr/unopened filehandle/, 'warns like an unopened filehandle' );
  49 }
  50
  51 # Test qualify()
  52 package foo;
  53
  54 use Symbol qw(qualify);  # must import into this package too
  55
  56 ::ok( qualify("x") eq "foo::x",         'qualify() with a simple identifier' );
  57 ::ok( qualify("x", "FOO") eq "FOO::x",  'qualify() with a package' );
  58 ::ok( qualify("BAR::x") eq "BAR::x",
  59     'qualify() with a qualified identifier' );
  60 ::ok( qualify("STDOUT") eq "main::STDOUT",
  61     'qualify() with a reserved identifier' );
  62 ::ok( qualify("ARGV", "FOO") eq "main::ARGV",
  63     'qualify() with a reserved identifier and a package' );
  64 ::ok( qualify("_foo") eq "foo::_foo",
  65     'qualify() with an identifier starting with a _' );
  66 ::ok( qualify("^FOO") eq "main::\cFOO",
  67     'qualify() with an identifier starting with a ^' );
  68
  69 # tests for delete_package
  70 package main;
  71 $Transient::variable = 42;
  72 ok( exists $::{'Transient::'}, 'transient stash exists' );
  73 ok( defined $Transient::{variable}, 'transient variable in stash' );
  74 Symbol::delete_package('Transient');
  75 ok( !exists $Transient::{variable}, 'transient variable no longer in stash' );
  76 is( scalar(keys %Transient::), 0, 'transient stash is empty' );
  77 ok( !exists $::{'Transient::'}, 'no transient stash' );