File: dctrl-parser.t

package info (click to toggle)
lintian 2.5.10.4
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 12,608 kB
  • sloc: perl: 12,430; sh: 5,787; makefile: 2,834; xml: 1,125; ansic: 347; python: 28; java: 9; tcl: 4; sed: 3
file content (52 lines) | stat: -rw-r--r-- 1,700 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use Lintian::Util qw(visit_dpkg_paragraph);

my $syntax_error = qr/syntax error at line \d+/;
my %TESTS_BAD = (
    'pgp-sig-before-start' => qr/${syntax_error}: PGP signature seen before start of signed message/,
    'pgp-two-signatures' => qr/${syntax_error}: Two PGP signatures \(first one at line \d+\)/,
    'pgp-unexpected-header' => qr/${syntax_error}: Unexpected .+ header/,
    'pgp-malformed-header' => qr/${syntax_error}: Malformed PGP header/,
    'pgp-two-signed-msgs' => qr/${syntax_error}: Expected at most one signed message \(previous at line \d+\)/,
    'pgp-no-end-pgp-header' => qr/${syntax_error}: End of file but expected a "END PGP SIGNATURE" header/,
    'pgp-leading-unsigned' => qr/${syntax_error}: PGP MESSAGE header must be first content if present/,
    'pgp-trailing-unsigned' => qr/${syntax_error}: Data after the PGP SIGNATURE/,
    'pgp-eof-missing-sign' => qr/${syntax_error}: End of file before "BEGIN PGP SIGNATURE"/,
);

my $DATADIR = $0;
$DATADIR =~ s,[^/]+$,,o;
if ($DATADIR) {
    # invokved in some other dir
    $DATADIR = "$DATADIR/data";
} else {
    # current dir
    $DATADIR = 'data';
}

plan skip_all => 'Data files not available'
    unless -d $DATADIR;

plan tests => scalar keys %TESTS_BAD;

foreach my $filename (sort keys %TESTS_BAD) {
    my $fail_regex = $TESTS_BAD{$filename};
    my $path = "$DATADIR/$filename";
    open my $fd, '<', $path or die "open $path: $!";
    eval {
        visit_dpkg_paragraph (sub {}, $fd);
    };
    close $fd;
    if (my $err = $@) {
        like ($err, $fail_regex, $filename);
    } else {
        fail ("$path was parsed successfully");
    }
}