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