| 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' ); |