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";
|
---|