Projet

Général

Profil

Paste
Télécharger au format
Statistiques
| Branche: | Révision:

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);