Mercurial > hg > chronicle
annotate tests/perl-syntax.t @ 148:f4f02112a523
Updated Debian files
| author | Steve Kemp <steve@steve.org.uk> |
|---|---|
| date | Fri, 28 Dec 2007 14:32:12 +0000 |
| parents | 00ed5b99ccb0 |
| children | 12a343d708a1 |
| rev | line source |
|---|---|
| 1 | 1 #!/usr/bin/perl -w |
| 2 # | |
| 3 # Test that every perl file we have passes the syntax check. | |
| 4 # | |
| 5 # Steve | |
| 6 # -- | |
|
77
00ed5b99ccb0
Removed $Id: $ markers from CVS times.
Steve Kemp <steve@steve.org.uk>
parents:
3
diff
changeset
|
7 |
| 1 | 8 |
| 9 | |
| 10 use strict; | |
| 11 use File::Find; | |
| 12 use Test::More qw( no_plan ); | |
| 13 | |
| 14 | |
| 15 # | |
| 16 # Find all the files beneath the current directory, | |
| 17 # and call 'checkFile' with the name. | |
| 18 # | |
| 19 find( { wanted => \&checkFile, no_chdir => 1 }, '.' ); | |
| 20 | |
| 21 | |
| 22 | |
| 23 # | |
| 24 # Check a file. | |
| 25 # | |
| 26 # If this is a perl file then call "perl -c $name", otherwise | |
| 27 # return | |
| 28 # | |
| 29 sub checkFile | |
| 30 { | |
| 31 # The file. | |
| 32 my $file = $File::Find::name; | |
| 33 | |
| 34 # We don't care about directories | |
| 35 return if ( ! -f $file ); | |
| 36 | |
| 37 # `modules.sh` is a false positive. | |
| 38 return if ( $file =~ /modules.sh$/ ); | |
| 39 | |
| 40 # See if it is a perl file. | |
| 41 my $isPerl = 0; | |
| 42 | |
| 43 # Read the file. | |
| 44 open( INPUT, "<", $file ); | |
| 45 foreach my $line ( <INPUT> ) | |
| 46 { | |
| 47 if ( $line =~ /\/usr\/bin\/perl/ ) | |
| 48 { | |
| 49 $isPerl = 1; | |
| 50 } | |
| 51 } | |
| 52 close( INPUT ); | |
| 53 | |
| 54 # | |
| 55 # Return if it wasn't a perl file. | |
| 56 # | |
| 57 return if ( ! $isPerl ); | |
| 58 | |
| 59 # | |
| 60 # Now run 'perl -c $file' to see if we pass the syntax | |
| 61 # check. We add a couple of parameters to make sure we're | |
| 62 # really OK. | |
| 63 # | |
| 64 # use strict "vars"; | |
| 65 # use strict "subs"; | |
| 66 # | |
| 67 my $retval = system( "perl -Mstrict=subs -Mstrict=vars -c $file 2>/dev/null >/dev/null" ); | |
| 68 | |
| 69 is( $retval, 0, "Perl file passes our syntax check: $file" ); | |
| 70 } |