Commit | Line | Data |
---|---|---|
66deed98 | 1 | #!./perl |
2 | ||
ba6f05db TR |
3 | use strict; |
4 | use warnings; | |
5 | ||
66deed98 | 6 | BEGIN { |
7 | chdir 't' if -d 't'; | |
20822f61 | 8 | @INC = '../lib'; |
66deed98 | 9 | } |
10 | ||
70cbce25 | 11 | use Test::More; |
66deed98 | 12 | |
13 | BEGIN { $_ = 'foo'; } # because Symbol used to clobber $_ | |
14 | ||
15 | use Symbol; | |
16 | ||
c74f62b5 | 17 | ok( $_ eq 'foo', 'check $_ clobbering' ); |
66deed98 | 18 | |
19 | ||
20 | # First test gensym() | |
d80a3ab2 | 21 | my $sym1 = gensym; |
c74f62b5 | 22 | ok( ref($sym1) eq 'GLOB', 'gensym() returns a GLOB' ); |
66deed98 | 23 | |
d80a3ab2 | 24 | my $sym2 = gensym; |
66deed98 | 25 | |
c74f62b5 | 26 | ok( $sym1 ne $sym2, 'gensym() returns a different GLOB' ); |
66deed98 | 27 | |
28 | ungensym $sym1; | |
29 | ||
30 | $sym1 = $sym2 = undef; | |
31 | ||
ae716a98 YST |
32 | # Test geniosym() |
33 | ||
34 | use Symbol qw(geniosym); | |
35 | ||
36 | $sym1 = geniosym; | |
37 | like( $sym1, qr/=IO\(/, 'got an IO ref' ); | |
38 | ||
d80a3ab2 | 39 | our $FOO = 'Eymascalar'; |
ae716a98 YST |
40 | *FOO = $sym1; |
41 | ||
42 | is( $sym1, *FOO{IO}, 'assigns into glob OK' ); | |
43 | ||
44 | is( $FOO, 'Eymascalar', 'leaves scalar alone' ); | |
45 | ||
46 | { | |
47 | local $^W=1; # 5.005 compat. | |
48 | my $warn; | |
49 | local $SIG{__WARN__} = sub { $warn .= "@_" }; | |
50 | readline FOO; | |
51 | like( $warn, qr/unopened filehandle/, 'warns like an unopened filehandle' ); | |
52 | } | |
66deed98 | 53 | |
54 | # Test qualify() | |
55 | package foo; | |
56 | ||
d80a3ab2 | 57 | use Symbol qw(qualify qualify_to_ref); # must import into this package too |
66deed98 | 58 | |
c74f62b5 RGS |
59 | ::ok( qualify("x") eq "foo::x", 'qualify() with a simple identifier' ); |
60 | ::ok( qualify("x", "FOO") eq "FOO::x", 'qualify() with a package' ); | |
61 | ::ok( qualify("BAR::x") eq "BAR::x", | |
62 | 'qualify() with a qualified identifier' ); | |
63 | ::ok( qualify("STDOUT") eq "main::STDOUT", | |
64 | 'qualify() with a reserved identifier' ); | |
65 | ::ok( qualify("ARGV", "FOO") eq "main::ARGV", | |
66 | 'qualify() with a reserved identifier and a package' ); | |
67 | ::ok( qualify("_foo") eq "foo::_foo", | |
68 | 'qualify() with an identifier starting with a _' ); | |
69 | ::ok( qualify("^FOO") eq "main::\cFOO", | |
70 | 'qualify() with an identifier starting with a ^' ); | |
d80a3ab2 JK |
71 | ::is( qualify('\*x'), 'foo::\*x', |
72 | 'qualify() reference to a typeglob' ); | |
73 | ::is( qualify('\*x', 'FOO'), 'FOO::\*x', | |
74 | 'qualify() reference to a typeglob' ); | |
75 | { | |
76 | use strict 'refs'; | |
77 | my $fhref = qualify_to_ref("main::STDOUT"); | |
78 | ::is( ref($fhref), 'GLOB', | |
79 | 'qualify_to_ref() returned ref to typeglob (1 argument)'); | |
80 | ||
81 | my $key = 'baz'; | |
82 | my $ref_to_key = qualify_to_ref( $key, __PACKAGE__ ); | |
83 | ::is( ref($ref_to_key), 'GLOB', | |
84 | 'qualify_to_ref() returned ref to typeglob (2 arguments)'); | |
85 | ||
86 | my $ref_to_key_scalar = *{$ref_to_key}{SCALAR}; | |
87 | ::is( ref($ref_to_key_scalar), 'SCALAR', | |
88 | 'able to get SCALAR entry in typeglob'); | |
89 | } | |
83628169 RGS |
90 | |
91 | # tests for delete_package | |
92 | package main; | |
ba6f05db | 93 | no warnings 'once'; |
83628169 RGS |
94 | $Transient::variable = 42; |
95 | ok( exists $::{'Transient::'}, 'transient stash exists' ); | |
96 | ok( defined $Transient::{variable}, 'transient variable in stash' ); | |
97 | Symbol::delete_package('Transient'); | |
98 | ok( !exists $Transient::{variable}, 'transient variable no longer in stash' ); | |
99 | is( scalar(keys %Transient::), 0, 'transient stash is empty' ); | |
100 | ok( !exists $::{'Transient::'}, 'no transient stash' ); | |
66759c69 JK |
101 | |
102 | $Foo::variable = 43; | |
103 | ok( exists $::{'Foo::'}, 'second transient stash exists' ); | |
104 | ok( defined $Foo::{variable}, 'second transient variable in stash' ); | |
105 | Symbol::delete_package('::Foo'); | |
106 | is( scalar(keys %Foo::), 0, 'second transient stash is empty' ); | |
107 | ok( !exists $::{'Foo::'}, 'no second transient stash' ); | |
108 | ||
109 | $Bar::variable = 44; | |
110 | ok( exists $::{'Bar::'}, 'third transient stash exists' ); | |
111 | ok( defined $Bar::{variable}, 'third transient variable in stash' ); | |
112 | ok( ! defined(Symbol::delete_package('Bar::Bar::')), | |
113 | 'delete_package() returns undef due to undefined leaf'); | |
70cbce25 MB |
114 | |
115 | done_testing(); |