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