chiark - git - mdw - dpkg/blob - scripts/t/Dpkg_Control.t

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 use strict;
  17 use warnings;
  18
  19 use Test::More;
  20 use Test::Dpkg qw(:needs :paths);
  21
  22 BEGIN {
  23     test_needs_module('IO::String');
  24
  25     plan tests => 24;
  26
  27     use_ok('Dpkg::Control');
  28     use_ok('Dpkg::Control::Info');
  29 }
  30
  31 my $datadir = test_get_data_path('t/Dpkg_Control');
  32
  33 sub parse_dsc {
  34     my $path = shift;
  35
  36     my $dsc = Dpkg::Control->new(type => CTRL_PKG_SRC);
  37     eval {
  38         $dsc->load($path);
  39         1;
  40     } or return;
  41
  42     return $dsc;
  43 }
  44
  45 my $c = Dpkg::Control::Info->new("$datadir/control-1");
  46
  47 my $io = IO::String->new();
  48 $c->output($io);
  49 my $value = ${$io->string_ref()};
  50 my $expected = 'Source: mysource
  51 Numeric-Field: 0
  52 My-Field-One: myvalue1
  53 My-Field-Two: myvalue2
  54 Long-Field: line1
  55  line 2 line 2 line 2
  56  .
  57    line 3 line 3 line 3
  58  .
  59  ..
  60  line 4
  61 Empty-Field:
  62
  63 Package: mypackage1
  64 Architecture: any
  65 Depends: libc6
  66
  67 Package: mypackage2
  68 Architecture: all
  69 Depends: hello
  70
  71 Package: mypackage3
  72 Architecture: all
  73 Depends: hello
  74 Description: short one
  75  long one
  76  very long one
  77 ';
  78 is($value, $expected, "Dump of $datadir/control-1");
  79
  80 my $src = $c->get_source();
  81 is($src, $c->[0], 'array representation of Dpkg::Control::Info 1/2');
  82 is($src->{'numeric-field'}, '0', 'Numeric 0 value parsed correctly');
  83 is($src->{'my-field-one'}, 'myvalue1', 'Access field through badly capitalized field name');
  84 is($src->{'long-field'},
  85 'line1
  86 line 2 line 2 line 2
  87
  88   line 3 line 3 line 3
  89
  90 .
  91 line 4', 'Get multi-line field');
  92 is($src->{'Empty-field'}, '', 'Get empty field');
  93
  94 my $pkg = $c->get_pkg_by_idx(1);
  95 is($pkg, $c->[1], 'array representation of Dpkg::Control::Info 2/2');
  96 is($pkg->{package}, 'mypackage1', 'Name of first package');
  97
  98 $pkg = $c->get_pkg_by_name('mypackage3');
  99 is($pkg->{package}, 'mypackage3', 'Name of third package');
 100 is($pkg->{Depends}, 'hello', 'Name of third package');
 101
 102 $pkg = $c->get_pkg_by_idx(2);
 103 $io = IO::String->new();
 104 $pkg->output($io);
 105
 106 is(${$io->string_ref()},
 107 'Package: mypackage2
 108 Architecture: all
 109 Depends: hello
 110 ', "Dump of second binary package of $datadir/control-1");
 111
 112 # Check OpenPGP armored signatures in source control files
 113
 114 my $dsc;
 115
 116 $dsc = parse_dsc("$datadir/bogus-unsigned.dsc");
 117 is($dsc, undef, 'Unsigned .dsc w/ OpenPGP armor');
 118
 119 $dsc = parse_dsc("$datadir/bogus-armor-no-sig.dsc");
 120 is($dsc, undef, 'Signed .dsc w/ OpenPGP armor missing signature');
 121
 122 $dsc = parse_dsc("$datadir/bogus-armor-trail.dsc");
 123 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP armor trailer');
 124
 125 $dsc = parse_dsc("$datadir/bogus-armor-inline.dsc");
 126 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP inline armor');
 127
 128 $dsc = parse_dsc("$datadir/bogus-armor-formfeed.dsc");
 129 is($dsc, undef, 'Signed .dsc w/ bogus OpenPGP armor line');
 130
 131 $dsc = parse_dsc("$datadir/bogus-armor-double.dsc");
 132 ok(defined $dsc, 'Signed .dsc w/ two OpenPGP armor signatures');
 133 is($dsc->{Source}, 'pass', 'Signed spaced .dsc package name');
 134
 135 $dsc = parse_dsc("$datadir/bogus-armor-spaces.dsc");
 136 ok(defined $dsc, 'Signed .dsc w/ spaced OpenPGP armor');
 137 is($dsc->{Source}, 'pass', 'Signed spaced .dsc package name');
 138
 139 $dsc = parse_dsc("$datadir/bogus-armor-nested.dsc");
 140 ok(defined $dsc, 'Signed .dsc w/ nested OpenPGP armor');
 141 is($dsc->{Source}, 'pass', 'Signed nested .dsc package name');