lib/vars.t

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