root / t / test.t @ 29e6f53c
Historique | Voir | Annoter | Télécharger (5,97 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 | 7ec35e17 | Lars Kruse | my $checkbashisms_location = `command -v checkbashisms 2>/dev/null`; |
| 60 | chomp($checkbashisms_location); |
||
| 61 | my $command; |
||
| 62 | if ($checkbashisms_location ne "") {
|
||
| 63 | # monkey-patch "checkbashisms" in order to allow "command -v" |
||
| 64 | # see https://unix.stackexchange.com/a/85250: "command -v" vs. which/hash/... |
||
| 65 | # see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=733511 |
||
| 66 | my $run_modified_checkbashisms = q/sed 's#command\\\s+-\[\^p\]#command\s+-[^pvV]#'/ |
||
| 67 | . " '$checkbashisms_location' | perl - '$file'"; |
||
| 68 | $command = [ 'sh', '-c', $run_modified_checkbashisms ]; |
||
| 69 | } else {
|
||
| 70 | # make sure that the non-confusing "checkbashisms not found" message is displayed |
||
| 71 | $command = [ 'checkbashisms', $file ]; |
||
| 72 | } |
||
| 73 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 74 | 7ec35e17 | Lars Kruse | { command => $command,
|
| 75 | 9b01da77 | Stig Sandbeck Mathisen | description => 'checkbashisms' |
| 76 | } |
||
| 77 | ); |
||
| 78 | 80cb3741 | Stig Sandbeck Mathisen | }; |
| 79 | } |
||
| 80 | 23336966 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{/bin/ksh} ) {
|
| 81 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 82 | { command => [ 'ksh', '-n', $file ],
|
||
| 83 | description => 'ksh syntax check', |
||
| 84 | c503e0db | Lars Kruse | filename => $filename |
| 85 | } |
||
| 86 | ); |
||
| 87 | } |
||
| 88 | 92e7aaf8 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{bash} ) {
|
| 89 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 90 | { command => [ 'bash', '-n', $file ],
|
||
| 91 | description => 'bash syntax check', |
||
| 92 | filename => $filename |
||
| 93 | } |
||
| 94 | ); |
||
| 95 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 96 | a6ea4c42 | András Korn | elsif ( $interpreter =~ m{/bin/zsh} ) {
|
| 97 | run_check( |
||
| 98 | { command => [ 'zsh', '-n', $file ],
|
||
| 99 | description => 'zsh syntax check', |
||
| 100 | filename => $filename |
||
| 101 | } |
||
| 102 | ); |
||
| 103 | } |
||
| 104 | 80cb3741 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{perl} ) {
|
| 105 | beca8999 | Stig Sandbeck Mathisen | my $command; |
| 106 | 08f196eb | Stig Sandbeck Mathisen | if ( $arguments =~ m{-.*T}mx ) {
|
| 107 | beca8999 | Stig Sandbeck Mathisen | $command = [ 'perl', '-cwT', $file ]; |
| 108 | } |
||
| 109 | else {
|
||
| 110 | $command = [ 'perl', '-cw', $file ]; |
||
| 111 | } |
||
| 112 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 113 | beca8999 | Stig Sandbeck Mathisen | { command => $command,
|
| 114 | 9b01da77 | Stig Sandbeck Mathisen | description => 'perl syntax check', |
| 115 | filename => $filename |
||
| 116 | } |
||
| 117 | ); |
||
| 118 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 119 | d1a8965b | Lars Kruse | elsif ( $interpreter =~ m{python3} ) {
|
| 120 | run_check( |
||
| 121 | { command => [ 'python3', '-m', 'py_compile', $file ],
|
||
| 122 | description => 'python3 compile', |
||
| 123 | filename => $filename |
||
| 124 | } |
||
| 125 | ); |
||
| 126 | } |
||
| 127 | 80cb3741 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{python} ) {
|
| 128 | f007901b | Stig Sandbeck Mathisen | run_check( |
| 129 | { command => [ 'python', '-m', 'py_compile', $file ],
|
||
| 130 | description => 'python compile', |
||
| 131 | filename => $filename |
||
| 132 | } |
||
| 133 | ); |
||
| 134 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 135 | elsif ( $interpreter =~ m{php} ) {
|
||
| 136 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 137 | { command => [ 'php', '-l', $file ],
|
||
| 138 | description => 'php syntax check', |
||
| 139 | filename => $filename |
||
| 140 | } |
||
| 141 | ); |
||
| 142 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 143 | elsif ( $interpreter =~ m{j?ruby} ) {
|
||
| 144 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 145 | { command => [ 'ruby', '-cw', $file ],
|
||
| 146 | description => 'ruby syntax check', |
||
| 147 | filename => $filename |
||
| 148 | } |
||
| 149 | ); |
||
| 150 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 151 | elsif ( $interpreter =~ m{gawk} ) {
|
||
| 152 | 9b01da77 | Stig Sandbeck Mathisen | run_check( |
| 153 | { command => [
|
||
| 154 | 'gawk', '--source', 'BEGIN { exit(0) } END { exit(0) }',
|
||
| 155 | 80cb3741 | Stig Sandbeck Mathisen | '--file', $file |
| 156 | 9b01da77 | Stig Sandbeck Mathisen | ], |
| 157 | description => 'gawk syntax check', |
||
| 158 | filename => $filename |
||
| 159 | } |
||
| 160 | 80cb3741 | Stig Sandbeck Mathisen | ); |
| 161 | } |
||
| 162 | 673303f1 | Stig Sandbeck Mathisen | elsif ( $interpreter =~ m{expect} ) {
|
| 163 | 9b01da77 | Stig Sandbeck Mathisen | SKIP: {
|
| 164 | skip 'no idea how to check expect scripts', 1; |
||
| 165 | pass("No pretending everything is ok");
|
||
| 166 | } |
||
| 167 | 673303f1 | Stig Sandbeck Mathisen | } |
| 168 | 80cb3741 | Stig Sandbeck Mathisen | else {
|
| 169 | fail( $filename . " unknown interpreter " . $interpreter ); |
||
| 170 | } |
||
| 171 | } |
||
| 172 | |||
| 173 | 9b01da77 | Stig Sandbeck Mathisen | sub run_check {
|
| 174 | my ($args) = @_; |
||
| 175 | my $check_command = $args->{command};
|
||
| 176 | my $description = $args->{description};
|
||
| 177 | my $filename = $args->{filename};
|
||
| 178 | |||
| 179 | my $message; |
||
| 180 | |||
| 181 | if ($filename) {
|
||
| 182 | $message = sprintf( '%s: %s', $filename, $description ); |
||
| 183 | } |
||
| 184 | else {
|
||
| 185 | $message = $description; |
||
| 186 | } |
||
| 187 | |||
| 188 | 80cb3741 | Stig Sandbeck Mathisen | my ( $stdout, $stderr, $exit ) = capture {
|
| 189 | system( @{$check_command} );
|
||
| 190 | }; |
||
| 191 | 9b01da77 | Stig Sandbeck Mathisen | |
| 192 | ok( ( $exit == 0 ), $message ); |
||
| 193 | |||
| 194 | if ($exit) {
|
||
| 195 | 6b5e75a0 | Stig Sandbeck Mathisen | diag( |
| 196 | sprintf( |
||
| 197 | "\nCommand: %s\n\nSTDOUT:\n\n%s\n\nSTDERR:\n\n%s\n\n", |
||
| 198 | join( " ", @{$check_command} ),
|
||
| 199 | $stdout, $stderr |
||
| 200 | ) |
||
| 201 | ); |
||
| 202 | 80cb3741 | Stig Sandbeck Mathisen | } |
| 203 | } |
||
| 204 | |||
| 205 | done_testing($num_plugins); |
