Commit | Line | Data |
---|---|---|
44428a46 FC |
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 1; # $[ | |
108 | # To avoid tests that are *too* weird, we’ll just check for definition. | |
109 | ${"foo::["}; # touch | |
110 | ok !defined ${"foo::["}, '$foo::['; | |
111 | ||
112 | use tests 4; # user/group vars | |
113 | # These are rw, but setting them is obviously going to make the test much | |
114 | # more complex than necessary. So, again, we check for definition. | |
115 | for(qw< < > ( ) >) { | |
116 | ${"foo::$_"}; # touch | |
117 | ok !defined ${"foo::$_"}, "\$foo::$_"; | |
118 | } | |
119 | ||
120 | use tests 1; # $^N | |
121 | # This is a cheeky little blighter. It’s not read-only, but setting it does | |
122 | # nothing. It is undefined by default. | |
123 | { | |
124 | my $thing; | |
125 | "felp" =~ /(.)(?{ $thing = ${"foo::\cN"} })/; | |
126 | ok !defined $thing, '$foo::^N'; | |
127 | } | |
128 | ||
129 | # I think that’s it! |