File: Control.t

package info (click to toggle)
dh-make-perl 0.129
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 1,292 kB
  • sloc: perl: 5,640; makefile: 34; sh: 25
file content (162 lines) | stat: -rw-r--r-- 5,890 bytes parent folder | download | duplicates (3)
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
#!/usr/bin/perl -w

use strict;
use warnings;

use Test::More;
use Test::Exception;
use Test::Differences;

BEGIN {
    use_ok('Debian::Control');
    use_ok('Debian::Control::Stanza::Source');
};

my $s;
lives_ok { $s = Debian::Control::Stanza::Source->new } 'Source constructs';
lives_ok { $s->Source('foo') } 'Source: set';

my $b;
lives_ok { $b = Debian::Control::Stanza::Binary->new } 'Binary constructs';
lives_ok { $b->Package('foo') } 'Package set';
lives_ok { $b->Depends('foo, bar (>= 5)') } 'Depends set';
isa_ok( $b->Depends, 'Debian::Dependencies', 'Depends is an object' );
ok( ( $b->Depends . '' ) eq 'foo, bar (>= 5)', 'Depends stringifies to the same' );
lives_ok { $b = Debian::Control::Stanza::Source->new( {
            'Build-Depends' => 'perl',
        } ) } 'Build-Depens is supported as a field in new()';
ok( $b->Build_Depends eq 'perl', 'and the value is in Build_Depends' );
lives_ok { $b = Debian::Control::Stanza::Source->new( {
            'build-depends' => 'perl8',
        } ) } 'bUiLd-DePeNdS is supported as a field in new()';
ok( $b->Build_Depends eq 'perl8', 'and the value is in Build_Depends' );

my $control = <<'EOF';
Source: libtest-compile-perl
Section: perl
Priority: optional
Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
Uploaders: Damyan Ivanov <dmn@debian.org>,
 Gregor Herrmann <gregoa@debian.org>,
 Gunnar Wolf <gwolf@debian.org>
Build-Depends: debhelper (>= 7),
 libmodule-build-perl,
 libtest-simple-perl
Build-Depends-Indep: libtest-pod-coverage-perl,
 libtest-pod-perl,
 libuniversal-require-perl,
 perl
Standards-Version: 3.8.3
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libtest-compile-perl/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libtest-compile-perl/
Homepage: https://metacpan.org/release/Test-Compile

Package: libtest-compile-perl
Architecture: all
Depends: ${misc:Depends}, ${perl:Depends},
 libuniversal-require-perl
Multi-Arch: foreign
Description: check whether Perl module files compile correctly
 Test::Compile can be used in module test suites to verify that everything
 compiles correctly. This description is artifitially prolonged, in order to be
 able to use some commas and test whether they wrap.
 .
 This module provides a few useful functions for manipulating module names. Its
 main aim is to centralise some of the functions commonly used by modules that
 manipulate other modules in some way, like converting module names to relative
 paths.
 .
 This description was automagically extracted from the module by dh-make-perl.
EOF
my $c;

lives_ok { $c = Debian::Control->new } 'Debian::Control constructs';
lives_ok { $c->read(\$control) } 'parses a real control file';
isa_ok( $c->source->Build_Depends_Indep, 'Debian::Dependencies', 'parsed source B-D-I is a Debian::Dependencies object' );
ok( $c->source->Build_Depends_Indep eq 'libtest-pod-coverage-perl, libtest-pod-perl, libuniversal-require-perl, perl', 'parsed B-D-I as expected' );

my $written = "";
lives_ok { $c->write(\$written) } 'Control writes can write to a scalar ref';
eq_or_diff( $written, $control, 'Control writes what it have read' );

use_ok('Debian::Control::FromCPAN');
bless $c, 'Debian::Control::FromCPAN';
$c->binary->{'libtest-compile-perl'}->Depends->add('perl-modules');
$c->prune_perl_deps;
is( $c->binary->{'libtest-compile-perl'}->Depends . '',
    '${misc:Depends}, ${perl:Depends}, libuniversal-require-perl'
);

# test pruning dependency on perl version found in oldstable
$c->binary->{'libtest-compile-perl'}->Depends->add('perl (>= 5.8.8)');
$c->prune_perl_deps;
is( $c->binary->{'libtest-compile-perl'}->Depends . '',
    '${misc:Depends}, ${perl:Depends}, libuniversal-require-perl'
);

# same thing, with B-D
$c->source->Build_Depends_Indep->add('perl (>= 5.8.8)');
$c->prune_perl_deps;
is( $c->source->Build_Depends_Indep . '',
    'libtest-pod-coverage-perl, libtest-pod-perl, libuniversal-require-perl, perl'
);

# Test wrapping
$b = Debian::Control::Stanza::Binary->new(
    {
        Package => "foo",
        Depends => "libfoo-perl (>= 0.44839848), libbar-perl, libbaz-perl (>= 4.59454345345485), libtreshchotka-moo (>= 5.6), libmoo-more-java (>= 9.6544)",
    },
);
is( "$b", <<EOF );
Package: foo
Depends: libfoo-perl (>= 0.44839848),
 libbar-perl,
 libbaz-perl (>= 4.59454345345485),
 libtreshchotka-moo (>= 5.6),
 libmoo-more-java (>= 9.6544)
EOF

# canonical / case-insensitive field names/accessors
lives_ok { $s = Debian::Control::Stanza::Source->new({'Vcs_Git' => 'git://example.org'}) } 'Source constructor with Vcs_Git';
can_ok($s, qw(Vcs_Git));
ok($s->Vcs_Git eq 'git://example.org', 'Vcs_Git returns correct value');
throws_ok { $s->vCs_GiT } qr/Invalid field 'vCs_GiT' requested/, 'No vCs_GiT field';

lives_ok { $s = Debian::Control::Stanza::Source->new({'vCs-GiT' => 'git://example.net'}) } 'Source constructor with vCs-GiT';
can_ok($s, qw(Vcs_Git));
ok($s->Vcs_Git eq 'git://example.net', 'Vcs_Git returns correct value');
throws_ok { $s->vCs_GiT } qr/Invalid field 'vCs_GiT' requested/, 'No method vCs_GiT';

ok( $s->looks_like_an_x_field('XS_Moon_Phase'),
    "XS_Moon_Phase looks like an X_ field"
);

ok( $s->looks_like_an_x_field('X_Hemisphere'),
    "X_Hemisphere looks like an X_ field"
);

ok( $s->looks_like_an_x_field('XB_Temperature'),
    "XB_Temperature looks like an X_ field"
);

ok( $s->looks_like_an_x_field('XS_CoolValue'),
    "XS_CoolValue looks like an X_ field"
);

ok( $s->looks_like_an_x_field('XSB_SourceBinary'),
    "XSB_SourceBinary looks like an X_ field"
);

ok( $s->looks_like_an_x_field('XSBC_Original_Maintainer'), # Ubuntu; LP: #1886461
    "XSBC_Original_Maintainer looks like an X_ field"
);

ok( !$s->looks_like_an_x_field('XFail'),
    "XFail doesn't look like an X_ field"
);

lives_ok { $s->XS_Moon_Phase("full") } "Can set XS_Moon_Phase";
is( $s->XS_Moon_Phase, 'full', 'Moon is full' );

done_testing;