Commit | Line | Data |
7eb43e02 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | $ENV{PERL5LIB} = '../lib'; |
7 | } |
8 | |
9 | $| = 1; |
10 | |
11 | print "1..27\n"; |
12 | |
13 | # catch "used once" warnings |
14 | my @warns; |
15 | BEGIN { $SIG{__WARN__} = sub { push @warns, @_ }; $^W = 1 }; |
16 | |
17 | %x = (); |
18 | $y = 3; |
19 | @z = (); |
20 | $X::x = 13; |
21 | |
22 | use vars qw($p @q %r *s &t $X::p); |
23 | |
24 | my $e = !(grep /^Name "X::x" used only once: possible typo/, @warns) && 'not '; |
25 | print "${e}ok 1\n"; |
26 | $e = !(grep /^Name "main::x" used only once: possible typo/, @warns) && 'not '; |
27 | print "${e}ok 2\n"; |
28 | $e = !(grep /^Name "main::y" used only once: possible typo/, @warns) && 'not '; |
29 | print "${e}ok 3\n"; |
30 | $e = !(grep /^Name "main::z" used only once: possible typo/, @warns) && 'not '; |
31 | print "${e}ok 4\n"; |
32 | ($e, @warns) = @warns != 4 && 'not '; |
33 | print "${e}ok 5\n"; |
34 | |
35 | # this is inside eval() to avoid creation of symbol table entries and |
36 | # to avoid "used once" warnings |
37 | eval <<'EOE'; |
38 | $e = ! $main::{p} && 'not '; |
39 | print "${e}ok 6\n"; |
40 | $e = ! *q{ARRAY} && 'not '; |
41 | print "${e}ok 7\n"; |
42 | $e = ! *r{HASH} && 'not '; |
43 | print "${e}ok 8\n"; |
44 | $e = ! $main::{s} && 'not '; |
45 | print "${e}ok 9\n"; |
46 | $e = ! *t{CODE} && 'not '; |
47 | print "${e}ok 10\n"; |
48 | $e = defined $X::{q} && 'not '; |
49 | print "${e}ok 11\n"; |
50 | $e = ! $X::{p} && 'not '; |
51 | print "${e}ok 12\n"; |
52 | EOE |
53 | $e = $@ && 'not '; |
54 | print "${e}ok 13\n"; |
55 | |
56 | eval q{use vars qw(@X::y !abc); $e = ! *X::y{ARRAY} && 'not '}; |
57 | print "${e}ok 14\n"; |
58 | $e = $@ !~ /^'!abc' is not a valid variable name/ && 'not '; |
59 | print "${e}ok 15\n"; |
60 | |
61 | eval 'use vars qw($x[3])'; |
62 | $e = $@ !~ /^Can't declare individual elements of hash or array/ && 'not '; |
63 | print "${e}ok 16\n"; |
64 | |
65 | { local $^W; |
66 | eval 'use vars qw($!)'; |
67 | ($e, @warns) = ($@ || @warns) ? 'not ' : ''; |
68 | print "${e}ok 17\n"; |
69 | }; |
70 | |
71 | # NB the next test only works because vars.pm has already been loaded |
72 | eval 'use warnings "vars"; use vars qw($!)'; |
73 | $e = ($@ || (shift(@warns)||'') !~ /^No need to declare built-in vars/) |
74 | && 'not '; |
75 | print "${e}ok 18\n"; |
76 | |
77 | no strict 'vars'; |
78 | eval 'use vars qw(@x%%)'; |
79 | $e = $@ && 'not '; |
80 | print "${e}ok 19\n"; |
81 | $e = ! *{'x%%'}{ARRAY} && 'not '; |
82 | print "${e}ok 20\n"; |
83 | eval '$u = 3; @v = (); %w = ()'; |
84 | $e = $@ && 'not '; |
85 | print "${e}ok 21\n"; |
86 | |
87 | use strict 'vars'; |
88 | eval 'use vars qw(@y%%)'; |
89 | $e = $@ !~ /^'\@y%%' is not a valid variable name under strict vars/ && 'not '; |
90 | print "${e}ok 22\n"; |
91 | $e = *{'y%%'}{ARRAY} && 'not '; |
92 | print "${e}ok 23\n"; |
93 | eval '$u = 3; @v = (); %w = ()'; |
94 | my @errs = split /\n/, $@; |
95 | $e = @errs != 3 && 'not '; |
96 | print "${e}ok 24\n"; |
97 | $e = !(grep(/^Global symbol "\$u" requires explicit package name/, @errs)) |
98 | && 'not '; |
99 | print "${e}ok 25\n"; |
100 | $e = !(grep(/^Global symbol "\@v" requires explicit package name/, @errs)) |
101 | && 'not '; |
102 | print "${e}ok 26\n"; |
103 | $e = !(grep(/^Global symbol "\%w" requires explicit package name/, @errs)) |
104 | && 'not '; |
105 | print "${e}ok 27\n"; |