root / t / test.t @ 37d81d7a
Historique | Voir | Annoter | Télécharger (8,23 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 | f42fdaa6 | Steve Schnepp | && -s _ |
| 22 | beca8999 | Stig Sandbeck Mathisen | && ( ( $interpreter, $arguments ) = hashbang("$_") )
|
| 23 | && ($interpreter) |
||
| 24 | 80cb3741 | Stig Sandbeck Mathisen | && ++$num_plugins |
| 25 | beca8999 | Stig Sandbeck Mathisen | && process_file( $_, $name, $interpreter, $arguments ); |
| 26 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 27 | |||
| 28 | e5abdeeb | Lars Kruse | File::Find::find( { wanted => \&wanted, no_chdir => 1 }, 'plugins' );
|
| 29 | 80cb3741 | Stig Sandbeck Mathisen | |
| 30 | sub hashbang {
|
||
| 31 | my ($filename) = @_; |
||
| 32 | open my $file, '<', $filename; |
||
| 33 | my $firstline = <$file>; |
||
| 34 | close $file; |
||
| 35 | |||
| 36 | beca8999 | Stig Sandbeck Mathisen | $firstline =~ m{ ^\#! # hashbang
|
| 37 | \s* # optional space |
||
| 38 | (?:/usr/bin/env\s+)? # optional /usr/bin/env |
||
| 39 | (?<interpreter>\S+) # interpreter |
||
| 40 | (?:\s+ |
||
| 41 | (?<arguments>[^\n]*) # optional interpreter arguments |
||
| 42 | )? |
||
| 43 | }xms; |
||
| 44 | 80cb3741 | Stig Sandbeck Mathisen | |
| 45 | 08f196eb | Stig Sandbeck Mathisen | return ( $+{interpreter}, $+{arguments} );
|
| 46 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 47 | |||
| 48 | sub process_file {
|
||
| 49 | beca8999 | Stig Sandbeck Mathisen | my ( $file, $filename, $interpreter, $arguments ) = @_; |
| 50 | 80cb3741 | Stig Sandbeck Mathisen | use v5.10.1; |
| 51 | |||
| 52 | 58f0ab64 | Steve Schnepp | if ( -r "$file.nocheck") {
|
| 53 | 878e7334 | Steve Schnepp | SKIP: {
|
| 54 | skip( sprintf("\nFile '%s' has a .nocheck flag. Ignoring\n", $file), 1);
|
||
| 55 | pass("Not pretending everything is ok");
|
||
| 56 | } |
||
| 57 | 58f0ab64 | Steve Schnepp | } |
| 58 | elsif ( ! -x $file ) {
|
||
| 59 | ebe5be1d | Lars Kruse | # missing executable flag |
| 60 | diag( |
||
| 61 | sprintf("\nFile '%s' lacks executable permission bits. Maybe try 'chmod +x $file'?\n",
|
||
| 62 | $file) |
||
| 63 | ); |
||
| 64 | } |
||
| 65 | elsif ( $interpreter =~ m{/bin/sh} ) {
|
||
| 66 | 80cb3741 | Stig Sandbeck Mathisen | subtest $filename => sub {
|
| 67 | e5abdeeb | Lars Kruse | plan tests => 3; |
| 68 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 69 | { command => [ 'sh', '-n', $file ],
|
||
| 70 | description => 'sh syntax check' |
||
| 71 | } |
||
| 72 | ); |
||
| 73 | 7ec35e17 | Lars Kruse | my $checkbashisms_location = `command -v checkbashisms 2>/dev/null`; |
| 74 | chomp($checkbashisms_location); |
||
| 75 | my $command; |
||
| 76 | if ($checkbashisms_location ne "") {
|
||
| 77 | # monkey-patch "checkbashisms" in order to allow "command -v" |
||
| 78 | # see https://unix.stackexchange.com/a/85250: "command -v" vs. which/hash/... |
||
| 79 | # see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=733511 |
||
| 80 | my $run_modified_checkbashisms = q/sed 's#command\\\s+-\[\^p\]#command\s+-[^pvV]#'/ |
||
| 81 | . " '$checkbashisms_location' | perl - '$file'"; |
||
| 82 | $command = [ 'sh', '-c', $run_modified_checkbashisms ]; |
||
| 83 | } else {
|
||
| 84 | # make sure that the non-confusing "checkbashisms not found" message is displayed |
||
| 85 | $command = [ 'checkbashisms', $file ]; |
||
| 86 | } |
||
| 87 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 88 | 7ec35e17 | Lars Kruse | { command => $command,
|
| 89 | 9b01da77 | Stig Sandbeck Mathisen | description => 'checkbashisms' |
| 90 | } |
||
| 91 | ); |
||
| 92 | e5abdeeb | Lars Kruse | run_check( |
| 93 | { command => [ 't/test-exception-wrapper', $file, 'shellcheck', '--exclude=SC1090,SC2009,SC2126,SC2230', '--shell=dash' ],
|
||
| 94 | description => 'shellcheck' |
||
| 95 | } |
||
| 96 | ); |
||
| 97 | 80cb3741 | Stig Sandbeck Mathisen | }; |
| 98 | } |
||
| 99 | 23336966 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{/bin/ksh} ) {
|
| 100 | 6c0e154e | Lars Kruse | subtest $filename => sub {
|
| 101 | plan tests => 2; |
||
| 102 | run_check( |
||
| 103 | { command => [ 'ksh', '-n', $file ],
|
||
| 104 | description => 'ksh syntax check', |
||
| 105 | filename => $filename |
||
| 106 | } |
||
| 107 | ); |
||
| 108 | run_check( |
||
| 109 | e5abdeeb | Lars Kruse | { command => [ 't/test-exception-wrapper', $file, 'shellcheck', '--shell=ksh' ],
|
| 110 | 6c0e154e | Lars Kruse | description => 'shellcheck' |
| 111 | } |
||
| 112 | ); |
||
| 113 | } |
||
| 114 | c503e0db | Lars Kruse | } |
| 115 | 92e7aaf8 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{bash} ) {
|
| 116 | e5abdeeb | Lars Kruse | subtest $filename => sub {
|
| 117 | plan tests => 2; |
||
| 118 | run_check( |
||
| 119 | { command => [ 'bash', '-n', $file ],
|
||
| 120 | description => 'bash syntax check', |
||
| 121 | filename => $filename |
||
| 122 | } |
||
| 123 | ); |
||
| 124 | run_check( |
||
| 125 | { command => [ 't/test-exception-wrapper', $file, 'shellcheck', '--exclude=SC1090,SC2009,SC2126,SC2230', '--shell=bash' ],
|
||
| 126 | description => 'shellcheck' |
||
| 127 | } |
||
| 128 | ); |
||
| 129 | } |
||
| 130 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 131 | a6ea4c42 | András Korn | elsif ( $interpreter =~ m{/bin/zsh} ) {
|
| 132 | run_check( |
||
| 133 | { command => [ 'zsh', '-n', $file ],
|
||
| 134 | description => 'zsh syntax check', |
||
| 135 | filename => $filename |
||
| 136 | } |
||
| 137 | ); |
||
| 138 | } |
||
| 139 | 80cb3741 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{perl} ) {
|
| 140 | beca8999 | Stig Sandbeck Mathisen | my $command; |
| 141 | 08f196eb | Stig Sandbeck Mathisen | if ( $arguments =~ m{-.*T}mx ) {
|
| 142 | beca8999 | Stig Sandbeck Mathisen | $command = [ 'perl', '-cwT', $file ]; |
| 143 | } |
||
| 144 | else {
|
||
| 145 | $command = [ 'perl', '-cw', $file ]; |
||
| 146 | } |
||
| 147 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 148 | beca8999 | Stig Sandbeck Mathisen | { command => $command,
|
| 149 | 9b01da77 | Stig Sandbeck Mathisen | description => 'perl syntax check', |
| 150 | filename => $filename |
||
| 151 | } |
||
| 152 | ); |
||
| 153 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 154 | d1a8965b | Lars Kruse | elsif ( $interpreter =~ m{python3} ) {
|
| 155 | e5abdeeb | Lars Kruse | subtest $filename => sub {
|
| 156 | plan tests => 2; |
||
| 157 | run_check( |
||
| 158 | { command => [ 'python3', '-m', 'py_compile', $file ],
|
||
| 159 | description => 'python3 compile', |
||
| 160 | filename => $filename |
||
| 161 | } |
||
| 162 | ); |
||
| 163 | run_check( |
||
| 164 | { command => [ 't/test-exception-wrapper', $file, 'python3', '-m', 'flake8' ],
|
||
| 165 | description => 'python3-flake8' |
||
| 166 | } |
||
| 167 | ); |
||
| 168 | } |
||
| 169 | d1a8965b | Lars Kruse | } |
| 170 | 80cb3741 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{python} ) {
|
| 171 | e5abdeeb | Lars Kruse | subtest $filename => sub {
|
| 172 | plan tests => 2; |
||
| 173 | run_check( |
||
| 174 | { command => [ 'python', '-m', 'py_compile', $file ],
|
||
| 175 | description => 'python compile', |
||
| 176 | filename => $filename |
||
| 177 | } |
||
| 178 | ); |
||
| 179 | run_check( |
||
| 180 | { command => [ 't/test-exception-wrapper', $file, 'python', '-m', 'flake8' ],
|
||
| 181 | description => 'python-flake8' |
||
| 182 | } |
||
| 183 | ); |
||
| 184 | } |
||
| 185 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 186 | elsif ( $interpreter =~ m{php} ) {
|
||
| 187 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 188 | { command => [ 'php', '-l', $file ],
|
||
| 189 | description => 'php syntax check', |
||
| 190 | filename => $filename |
||
| 191 | } |
||
| 192 | ); |
||
| 193 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 194 | elsif ( $interpreter =~ m{j?ruby} ) {
|
||
| 195 | 758c3ecd | Lars Kruse | subtest $filename => sub {
|
| 196 | plan tests => 2; |
||
| 197 | run_check( |
||
| 198 | { command => [ 'ruby', '-cw', $file ],
|
||
| 199 | description => 'ruby syntax check', |
||
| 200 | filename => $filename |
||
| 201 | } |
||
| 202 | ); |
||
| 203 | run_check( |
||
| 204 | 3143c2c5 | Lars Kruse | { command => [ 't/test-exception-wrapper', $file, 'rubocop' ],
|
| 205 | 758c3ecd | Lars Kruse | description => 'ruby style and syntax check', |
| 206 | filename => $filename |
||
| 207 | } |
||
| 208 | ); |
||
| 209 | } |
||
| 210 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 211 | elsif ( $interpreter =~ m{gawk} ) {
|
||
| 212 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 213 | { command => [
|
||
| 214 | 'gawk', '--source', 'BEGIN { exit(0) } END { exit(0) }',
|
||
| 215 | 80cb3741 | Stig Sandbeck Mathisen | '--file', $file |
| 216 | 9b01da77 | Stig Sandbeck Mathisen | ], |
| 217 | description => 'gawk syntax check', |
||
| 218 | filename => $filename |
||
| 219 | } |
||
| 220 | 80cb3741 | Stig Sandbeck Mathisen | ); |
| 221 | } |
||
| 222 | 673303f1 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{expect} ) {
|
| 223 | 9b01da77 | Stig Sandbeck Mathisen | SKIP: {
|
| 224 | skip 'no idea how to check expect scripts', 1; |
||
| 225 | pass("No pretending everything is ok");
|
||
| 226 | } |
||
| 227 | 673303f1 | Stig Sandbeck Mathisen | } |
| 228 | 80cb3741 | Stig Sandbeck Mathisen | else {
|
| 229 | fail( $filename . " unknown interpreter " . $interpreter ); |
||
| 230 | } |
||
| 231 | } |
||
| 232 | |||
| 233 | 9b01da77 | Stig Sandbeck Mathisen | sub run_check {
|
| 234 | my ($args) = @_; |
||
| 235 | my $check_command = $args->{command};
|
||
| 236 | my $description = $args->{description};
|
||
| 237 | my $filename = $args->{filename};
|
||
| 238 | |||
| 239 | my $message; |
||
| 240 | |||
| 241 | if ($filename) {
|
||
| 242 | $message = sprintf( '%s: %s', $filename, $description ); |
||
| 243 | } |
||
| 244 | else {
|
||
| 245 | $message = $description; |
||
| 246 | } |
||
| 247 | |||
| 248 | 80cb3741 | Stig Sandbeck Mathisen | my ( $stdout, $stderr, $exit ) = capture {
|
| 249 | system( @{$check_command} );
|
||
| 250 | }; |
||
| 251 | 9b01da77 | Stig Sandbeck Mathisen | |
| 252 | ok( ( $exit == 0 ), $message ); |
||
| 253 | |||
| 254 | if ($exit) {
|
||
| 255 | 6b5e75a0 | Stig Sandbeck Mathisen | diag( |
| 256 | sprintf( |
||
| 257 | "\nCommand: %s\n\nSTDOUT:\n\n%s\n\nSTDERR:\n\n%s\n\n", |
||
| 258 | join( " ", @{$check_command} ),
|
||
| 259 | $stdout, $stderr |
||
| 260 | ) |
||
| 261 | ); |
||
| 262 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 263 | } |
||
| 264 | |||
| 265 | done_testing($num_plugins); |
