| 1 | #!./perl -w
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | if ($ENV{PERL_CORE}){
|
|---|
| 5 | chdir('t') if -d 't';
|
|---|
| 6 | @INC = ('.', '../lib');
|
|---|
| 7 | } else {
|
|---|
| 8 | unshift @INC, 't';
|
|---|
| 9 | push @INC, "../../t";
|
|---|
| 10 | }
|
|---|
| 11 | require Config;
|
|---|
| 12 | if (($Config::Config{'extensions'} !~ /\bB\b/) ){
|
|---|
| 13 | print "1..0 # Skip -- Perl configured without B module\n";
|
|---|
| 14 | exit 0;
|
|---|
| 15 | }
|
|---|
| 16 | require 'test.pl';
|
|---|
| 17 | }
|
|---|
| 18 |
|
|---|
| 19 | plan tests => 15; # adjust also number of skipped tests !
|
|---|
| 20 |
|
|---|
| 21 | # Runs a separate perl interpreter with the appropriate lint options
|
|---|
| 22 | # turned on
|
|---|
| 23 | sub runlint ($$$;$) {
|
|---|
| 24 | my ($opts,$prog,$result,$testname) = @_;
|
|---|
| 25 | my $res = runperl(
|
|---|
| 26 | switches => [ "-MO=Lint,$opts" ],
|
|---|
| 27 | prog => $prog,
|
|---|
| 28 | stderr => 1,
|
|---|
| 29 | );
|
|---|
| 30 | $res =~ s/-e syntax OK\n$//;
|
|---|
| 31 | is( $res, $result, $testname || $opts );
|
|---|
| 32 | }
|
|---|
| 33 |
|
|---|
| 34 | runlint 'context', '$foo = @bar', <<'RESULT';
|
|---|
| 35 | Implicit scalar context for array in scalar assignment at -e line 1
|
|---|
| 36 | RESULT
|
|---|
| 37 |
|
|---|
| 38 | runlint 'context', '$foo = length @bar', <<'RESULT';
|
|---|
| 39 | Implicit scalar context for array in length at -e line 1
|
|---|
| 40 | RESULT
|
|---|
| 41 |
|
|---|
| 42 | runlint 'implicit-read', '/foo/', <<'RESULT';
|
|---|
| 43 | Implicit match on $_ at -e line 1
|
|---|
| 44 | RESULT
|
|---|
| 45 |
|
|---|
| 46 | runlint 'implicit-write', 's/foo/bar/', <<'RESULT';
|
|---|
| 47 | Implicit substitution on $_ at -e line 1
|
|---|
| 48 | RESULT
|
|---|
| 49 |
|
|---|
| 50 | SKIP : {
|
|---|
| 51 |
|
|---|
| 52 | use Config;
|
|---|
| 53 | skip("Doesn't work with threaded perls",11)
|
|---|
| 54 | if $Config{useithreads} || ($] < 5.009 && $Config{use5005threads});
|
|---|
| 55 |
|
|---|
| 56 | runlint 'implicit-read', '1 for @ARGV', <<'RESULT', 'implicit-read in foreach';
|
|---|
| 57 | Implicit use of $_ in foreach at -e line 1
|
|---|
| 58 | RESULT
|
|---|
| 59 |
|
|---|
| 60 | runlint 'dollar-underscore', '$_ = 1', <<'RESULT';
|
|---|
| 61 | Use of $_ at -e line 1
|
|---|
| 62 | RESULT
|
|---|
| 63 |
|
|---|
| 64 | runlint 'dollar-underscore', 'print', <<'RESULT', 'dollar-underscore in print';
|
|---|
| 65 | Use of $_ at -e line 1
|
|---|
| 66 | RESULT
|
|---|
| 67 |
|
|---|
| 68 | runlint 'private-names', 'sub A::_f{};A::_f()', <<'RESULT';
|
|---|
| 69 | Illegal reference to private name _f at -e line 1
|
|---|
| 70 | RESULT
|
|---|
| 71 |
|
|---|
| 72 | runlint 'private-names', '$A::_x', <<'RESULT';
|
|---|
| 73 | Illegal reference to private name _x at -e line 1
|
|---|
| 74 | RESULT
|
|---|
| 75 |
|
|---|
| 76 | runlint 'private-names', 'sub A::_f{};A->_f()', <<'RESULT',
|
|---|
| 77 | Illegal reference to private method name _f at -e line 1
|
|---|
| 78 | RESULT
|
|---|
| 79 | 'private-names (method)';
|
|---|
| 80 |
|
|---|
| 81 | runlint 'undefined-subs', 'foo()', <<'RESULT';
|
|---|
| 82 | Undefined subroutine foo called at -e line 1
|
|---|
| 83 | RESULT
|
|---|
| 84 |
|
|---|
| 85 | runlint 'regexp-variables', 'print $&', <<'RESULT';
|
|---|
| 86 | Use of regexp variable $& at -e line 1
|
|---|
| 87 | RESULT
|
|---|
| 88 |
|
|---|
| 89 | runlint 'regexp-variables', 's/./$&/', <<'RESULT';
|
|---|
| 90 | Use of regexp variable $& at -e line 1
|
|---|
| 91 | RESULT
|
|---|
| 92 |
|
|---|
| 93 | runlint 'bare-subs', 'sub bare(){1};$x=bare', '';
|
|---|
| 94 |
|
|---|
| 95 | runlint 'bare-subs', 'sub bare(){1}; $x=[bare=>0]; $x=$y{bare}', <<'RESULT';
|
|---|
| 96 | Bare sub name 'bare' interpreted as string at -e line 1
|
|---|
| 97 | Bare sub name 'bare' interpreted as string at -e line 1
|
|---|
| 98 | RESULT
|
|---|
| 99 |
|
|---|
| 100 | }
|
|---|