root / t / test.t @ a6ea4c42
Historique | Voir | Annoter | Télécharger (4,88 ko)
| 1 | 80cb3741 | Stig Sandbeck Mathisen | # -*- perl -*- |
|---|---|---|---|
| 2 | |||
| 3 | use strict; |
||
| 4 | use warnings; |
||
| 5 | |||
| 6 | use Test::More; |
||
| 7 | use File::Find (); |
||
| 8 | use Capture::Tiny ':all'; |
||
| 9 | |||
| 10 | use vars qw/*name *dir *prune/; |
||
| 11 | *name = *File::Find::name; |
||
| 12 | *dir = *File::Find::dir; |
||
| 13 | *prune = *File::Find::prune; |
||
| 14 | my $num_plugins = 0; |
||
| 15 | |||
| 16 | sub wanted {
|
||
| 17 | beca8999 | Stig Sandbeck Mathisen | my ( $dev, $ino, $mode, $nlink, $uid, $gid, $interpreter, $arguments ); |
| 18 | 80cb3741 | Stig Sandbeck Mathisen | |
| 19 | ( ( $dev, $ino, $mode, $nlink, $uid, $gid ) = lstat($_) ) |
||
| 20 | && -f _ |
||
| 21 | beca8999 | Stig Sandbeck Mathisen | && ( ( $interpreter, $arguments ) = hashbang("$_") )
|
| 22 | && ($interpreter) |
||
| 23 | 80cb3741 | Stig Sandbeck Mathisen | && ++$num_plugins |
| 24 | beca8999 | Stig Sandbeck Mathisen | && process_file( $_, $name, $interpreter, $arguments ); |
| 25 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 26 | |||
| 27 | File::Find::find( { wanted => \&wanted }, 'plugins' );
|
||
| 28 | |||
| 29 | sub hashbang {
|
||
| 30 | my ($filename) = @_; |
||
| 31 | open my $file, '<', $filename; |
||
| 32 | my $firstline = <$file>; |
||
| 33 | close $file; |
||
| 34 | |||
| 35 | beca8999 | Stig Sandbeck Mathisen | $firstline =~ m{ ^\#! # hashbang
|
| 36 | \s* # optional space |
||
| 37 | (?:/usr/bin/env\s+)? # optional /usr/bin/env |
||
| 38 | (?<interpreter>\S+) # interpreter |
||
| 39 | (?:\s+ |
||
| 40 | (?<arguments>[^\n]*) # optional interpreter arguments |
||
| 41 | )? |
||
| 42 | }xms; |
||
| 43 | 80cb3741 | Stig Sandbeck Mathisen | |
| 44 | 08f196eb | Stig Sandbeck Mathisen | return ( $+{interpreter}, $+{arguments} );
|
| 45 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 46 | |||
| 47 | sub process_file {
|
||
| 48 | beca8999 | Stig Sandbeck Mathisen | my ( $file, $filename, $interpreter, $arguments ) = @_; |
| 49 | 80cb3741 | Stig Sandbeck Mathisen | use v5.10.1; |
| 50 | |||
| 51 | if ( $interpreter =~ m{/bin/sh} ) {
|
||
| 52 | subtest $filename => sub {
|
||
| 53 | plan tests => 2; |
||
| 54 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 55 | { command => [ 'sh', '-n', $file ],
|
||
| 56 | description => 'sh syntax check' |
||
| 57 | } |
||
| 58 | ); |
||
| 59 | run_check( |
||
| 60 | { command => [ 'checkbashisms', $file ],
|
||
| 61 | description => 'checkbashisms' |
||
| 62 | } |
||
| 63 | ); |
||
| 64 | 80cb3741 | Stig Sandbeck Mathisen | }; |
| 65 | } |
||
| 66 | 23336966 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{/bin/ksh} ) {
|
| 67 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 68 | { command => [ 'ksh', '-n', $file ],
|
||
| 69 | description => 'ksh syntax check', |
||
| 70 | filename => $filename |
||
| 71 | } |
||
| 72 | ); |
||
| 73 | 23336966 | Stig Sandbeck Mathisen | } |
| 74 | 92e7aaf8 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{bash} ) {
|
| 75 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 76 | { command => [ 'bash', '-n', $file ],
|
||
| 77 | description => 'bash syntax check', |
||
| 78 | filename => $filename |
||
| 79 | } |
||
| 80 | ); |
||
| 81 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 82 | a6ea4c42 | András Korn | elsif ( $interpreter =~ m{/bin/zsh} ) {
|
| 83 | run_check( |
||
| 84 | { command => [ 'zsh', '-n', $file ],
|
||
| 85 | description => 'zsh syntax check', |
||
| 86 | filename => $filename |
||
| 87 | } |
||
| 88 | ); |
||
| 89 | } |
||
| 90 | 80cb3741 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{perl} ) {
|
| 91 | beca8999 | Stig Sandbeck Mathisen | my $command; |
| 92 | 08f196eb | Stig Sandbeck Mathisen | if ( $arguments =~ m{-.*T}mx ) {
|
| 93 | beca8999 | Stig Sandbeck Mathisen | $command = [ 'perl', '-cwT', $file ]; |
| 94 | } |
||
| 95 | else {
|
||
| 96 | $command = [ 'perl', '-cw', $file ]; |
||
| 97 | } |
||
| 98 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 99 | beca8999 | Stig Sandbeck Mathisen | { command => $command,
|
| 100 | 9b01da77 | Stig Sandbeck Mathisen | description => 'perl syntax check', |
| 101 | filename => $filename |
||
| 102 | } |
||
| 103 | ); |
||
| 104 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 105 | elsif ( $interpreter =~ m{python} ) {
|
||
| 106 | f007901b | Stig Sandbeck Mathisen | run_check( |
| 107 | { command => [ 'python', '-m', 'py_compile', $file ],
|
||
| 108 | description => 'python compile', |
||
| 109 | filename => $filename |
||
| 110 | } |
||
| 111 | ); |
||
| 112 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 113 | elsif ( $interpreter =~ m{php} ) {
|
||
| 114 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 115 | { command => [ 'php', '-l', $file ],
|
||
| 116 | description => 'php syntax check', |
||
| 117 | filename => $filename |
||
| 118 | } |
||
| 119 | ); |
||
| 120 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 121 | elsif ( $interpreter =~ m{j?ruby} ) {
|
||
| 122 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 123 | { command => [ 'ruby', '-cw', $file ],
|
||
| 124 | description => 'ruby syntax check', |
||
| 125 | filename => $filename |
||
| 126 | } |
||
| 127 | ); |
||
| 128 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 129 | elsif ( $interpreter =~ m{gawk} ) {
|
||
| 130 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 131 | { command => [
|
||
| 132 | 'gawk', '--source', 'BEGIN { exit(0) } END { exit(0) }',
|
||
| 133 | 80cb3741 | Stig Sandbeck Mathisen | '--file', $file |
| 134 | 9b01da77 | Stig Sandbeck Mathisen | ], |
| 135 | description => 'gawk syntax check', |
||
| 136 | filename => $filename |
||
| 137 | } |
||
| 138 | 80cb3741 | Stig Sandbeck Mathisen | ); |
| 139 | } |
||
| 140 | 673303f1 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{expect} ) {
|
| 141 | 9b01da77 | Stig Sandbeck Mathisen | SKIP: {
|
| 142 | skip 'no idea how to check expect scripts', 1; |
||
| 143 | pass("No pretending everything is ok");
|
||
| 144 | } |
||
| 145 | 673303f1 | Stig Sandbeck Mathisen | } |
| 146 | 80cb3741 | Stig Sandbeck Mathisen | else {
|
| 147 | fail( $filename . " unknown interpreter " . $interpreter ); |
||
| 148 | } |
||
| 149 | } |
||
| 150 | |||
| 151 | 9b01da77 | Stig Sandbeck Mathisen | sub run_check {
|
| 152 | my ($args) = @_; |
||
| 153 | my $check_command = $args->{command};
|
||
| 154 | my $description = $args->{description};
|
||
| 155 | my $filename = $args->{filename};
|
||
| 156 | |||
| 157 | my $message; |
||
| 158 | |||
| 159 | if ($filename) {
|
||
| 160 | $message = sprintf( '%s: %s', $filename, $description ); |
||
| 161 | } |
||
| 162 | else {
|
||
| 163 | $message = $description; |
||
| 164 | } |
||
| 165 | |||
| 166 | 80cb3741 | Stig Sandbeck Mathisen | my ( $stdout, $stderr, $exit ) = capture {
|
| 167 | system( @{$check_command} );
|
||
| 168 | }; |
||
| 169 | 9b01da77 | Stig Sandbeck Mathisen | |
| 170 | ok( ( $exit == 0 ), $message ); |
||
| 171 | |||
| 172 | if ($exit) {
|
||
| 173 | 6b5e75a0 | Stig Sandbeck Mathisen | diag( |
| 174 | sprintf( |
||
| 175 | "\nCommand: %s\n\nSTDOUT:\n\n%s\n\nSTDERR:\n\n%s\n\n", |
||
| 176 | join( " ", @{$check_command} ),
|
||
| 177 | $stdout, $stderr |
||
| 178 | ) |
||
| 179 | ); |
||
| 180 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 181 | } |
||
| 182 | |||
| 183 | done_testing($num_plugins); |