summaryrefslogtreecommitdiffstats
path: root/t/scripts/Lintian/Relation/05-invalid.t
blob: 9b42d6290464daa6993b7fcf226f08ec6f1d53e5 (plain)
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#!/usr/bin/perl

use strict;
use warnings;
use Test::More;

use Lintian::Relation;

test_relation(
    'pkg%any (>= 1.0)  ,  pkgB   |  _gf  ,  pkgC(>=2.0)',
    'satisfied' => [
        'pkgB | _gf', # partly unparsable, but identity holds
        'pkgC (>= 1.0)', # regular entry
    ],
    'not-satisfied' => [
        'pkg',     # unparsable
        'pkg%any', # unparsable
        'pkgB',    # OR relation with unparsable entry
        '_gf',     # OR relation
    ],
    'unparsable' => ['_gf', 'pkg%any (>= 1.0)'],
    'reconstituted' => 'pkg%any (>= 1.0), pkgB | _gf, pkgC (>= 2.0)'
);

done_testing;

sub test_relation {
    my ($text, %tests) = @_;

    my $relation_under_test = Lintian::Relation->new->load($text);

    my $tests = 0;
    if (my $reconstituted = $tests{'reconstituted'}) {
        is($relation_under_test->to_string,
            $reconstituted, "Reconstitute $text");
        $tests++;
    }

    for my $other_relation (@{$tests{'satisfied'} // [] }) {
        ok($relation_under_test->satisfies($other_relation),
            "'$text' satisfies '$other_relation'");
        $tests++;
    }

    for my $other_relation (@{$tests{'not-satisfied'} // [] }) {
        ok(
            !$relation_under_test->satisfies($other_relation),
            "'$text' does NOT satisfy '$other_relation'"
        );
        $tests++;
    }

    if (my $unparsable = $tests{'unparsable'}) {
        my @actual = $relation_under_test->unparsable_predicates;
        is_deeply(\@actual, $unparsable, "Unparsable entries for '$text'");
    }

    cmp_ok($tests, '>=', 1, "Ran at least one test on '$text'");
    return;
}

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et