Projet

Général

Profil

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

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