chiark - git - mdw - dpkg/blob - scripts/t/Dpkg_Changelog.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 tests => 94;
  20 use Test::Dpkg qw(:paths);
  21
  22 use File::Basename;
  23
  24 use Dpkg::File;
  25
  26 BEGIN {
  27     use_ok('Dpkg::Changelog');
  28     use_ok('Dpkg::Changelog::Debian');
  29     use_ok('Dpkg::Vendor', qw(get_current_vendor));
  30 };
  31
  32 my $datadir = test_get_data_path('t/Dpkg_Changelog');
  33
  34 my $vendor = get_current_vendor();
  35
  36 #########################
  37
  38 foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
  39     "$datadir/regressions", "$datadir/date-format") {
  40
  41     my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
  42     $changes->load($file);
  43
  44     open(my $clog_fh, '<', "$file") or die "can't open $file\n";
  45     my $content = file_slurp($clog_fh);
  46     close($clog_fh);
  47     cmp_ok($content, 'eq', "$changes", "string output of Dpkg::Changelog on $file");
  48
  49     my $errors = $changes->get_parse_errors();
  50     my $basename = basename( $file );
  51     is($errors, '', "Parse example changelog $file without errors" );
  52
  53     my @data = @$changes;
  54     ok(@data, 'data is not empty');
  55
  56     my $str;
  57     if ($file eq "$datadir/countme") {
  58         # test range options
  59         cmp_ok(@data, '==', 7, 'no options -> count');
  60         my $all_versions = join( '/', map { $_->get_version() } @data);
  61
  62         sub check_options {
  63             my ($changes, $data, $options, $count, $versions,
  64                 $check_name) = @_;
  65
  66             my @cnt = $changes->get_range($options);
  67             cmp_ok( @cnt, '==', $count, "$check_name -> count" );
  68             if ($count == @$data) {
  69                 is_deeply( \@cnt, $data, "$check_name -> returns all" );
  70
  71             } else {
  72                 is( join( '/', map { $_->get_version() } @cnt),
  73                     $versions, "$check_name -> versions" );
  74             }
  75         }
  76
  77         check_options( $changes, \@data,
  78                        { count => 3 }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
  79                        'positive count' );
  80         check_options( $changes, \@data,
  81                        { count => -3 }, 3,
  82                        '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
  83                        'negative count' );
  84         check_options( $changes, \@data,
  85                        { count => 1 }, 1, '2:2.0-1',
  86                        'count 1' );
  87         check_options( $changes, \@data,
  88                        { count => 1, default_all => 1 }, 1, '2:2.0-1',
  89                        'count 1 (d_a 1)' );
  90         check_options( $changes, \@data,
  91                        { count => -1 }, 1, '1.5-1',
  92                        'count -1' );
  93
  94         check_options( $changes, \@data,
  95                        { count => 3, offset => 2 }, 3,
  96                        '1:2.0~rc2-2/1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2',
  97                        'positive count + positive offset' );
  98         check_options( $changes, \@data,
  99                        { count => -3, offset => 4 }, 3,
 100                        '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
 101                        'negative count + positive offset' );
 102
 103         check_options( $changes, \@data,
 104                        { count => 4, offset => 5 }, 2,
 105                        '1:2.0~rc2-1sarge1/1.5-1',
 106                        'positive count + positive offset (>max)' );
 107         check_options( $changes, \@data,
 108                        { count => -4, offset => 2 }, 2,
 109                        '2:2.0-1/1:2.0~rc2-3',
 110                        'negative count + positive offset (<0)' );
 111
 112         check_options( $changes, \@data,
 113                        { count => 3, offset => -4 }, 3,
 114                        '1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1',
 115                        'positive count + negative offset' );
 116         check_options( $changes, \@data,
 117                        { count => -3, offset => -3 }, 3,
 118                        '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
 119                        'negative count + negative offset' );
 120
 121         check_options( $changes, \@data,
 122                        { count => 5, offset => -2 }, 2,
 123                        '1:2.0~rc2-1sarge1/1.5-1',
 124                        'positive count + negative offset (>max)' );
 125         check_options( $changes, \@data,
 126                        { count => -5, offset => -4 }, 3,
 127                        '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
 128                        'negative count + negative offset (<0)' );
 129
 130         check_options( $changes, \@data,
 131                        { count => 7 }, 7, '',
 132                        'count 7 (max)' );
 133         check_options( $changes, \@data,
 134                        { count => -7 }, 7, '',
 135                        'count -7 (-max)' );
 136         check_options( $changes, \@data,
 137                        { count => 10 }, 7, '',
 138                        'count 10 (>max)' );
 139         check_options( $changes, \@data,
 140                        { count => -10 }, 7, '',
 141                        'count -10 (<-max)' );
 142
 143         check_options( $changes, \@data,
 144                        { from => '1:2.0~rc2-1sarge3' }, 4,
 145                        '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
 146                        'from => "1:2.0~rc2-1sarge3"' );
 147         check_options( $changes, \@data,
 148                        { since => '1:2.0~rc2-1sarge3' }, 3,
 149                        '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
 150                        'since => "1:2.0~rc2-1sarge3"' );
 151         $SIG{__WARN__} = sub {};
 152         check_options( $changes, \@data,
 153                        { since => 0 }, 7, '',
 154                        'since => 0 returns all');
 155         delete $SIG{__WARN__};
 156         check_options( $changes, \@data,
 157                        { to => '1:2.0~rc2-1sarge2' }, 3,
 158                        '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
 159                        'to => "1:2.0~rc2-1sarge2"' );
 160         ## no critic (ControlStructures::ProhibitUntilBlocks)
 161         check_options( $changes, \@data,
 162                        { until => '1:2.0~rc2-1sarge2' }, 2,
 163                        '1:2.0~rc2-1sarge1/1.5-1',
 164                        'until => "1:2.0~rc2-1sarge2"' );
 165         ## use critic
 166         #TODO: test combinations
 167     }
 168     if ($file eq "$datadir/fields") {
 169         my $str = $changes->format_range('dpkg', { all => 1 });
 170         my $expected = 'Source: fields
 171 Version: 2.0-0etch1
 172 Distribution: stable
 173 Urgency: high
 174 Maintainer: Frank Lichtenheld <frank@lichtenheld.de>
 175 Timestamp: 1200235759
 176 Date: Sun, 13 Jan 2008 15:49:19 +0100
 177 Closes: 1000000 1111111 2222222
 178 Changes:
 179  fields (2.0-0etch1) stable; urgency=low
 180  .
 181    * Upload to stable (Closes: #1111111, #2222222)
 182    * Fix more stuff. (LP: #54321, #2424242)
 183  .
 184  fields (2.0-1) unstable  frozen; urgency=medium
 185  .
 186    [ Frank Lichtenheld ]
 187    * Upload to unstable (Closes: #1111111, #2222222)
 188    * Fix stuff. (LP: #12345, #424242)
 189  .
 190    [ Raphaël Hertzog ]
 191    * New upstream release.
 192      - implements a
 193      - implements b
 194    * Update S-V.
 195  .
 196  fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
 197  .
 198    * Beta
 199  .
 200  fields (1.0) experimental; urgency=high,xb-userfield2=foobar
 201  .
 202    * First upload (Closes: #1000000)
 203 Xb-Userfield2: foobar
 204 Xc-Userfield: foobar
 205
 206 ';
 207         if ($vendor eq 'Ubuntu') {
 208             $expected =~ s/^(Closes:.*)/$1\nLaunchpad-Bugs-Fixed: 12345 54321 424242 2424242/m;
 209         }
 210         cmp_ok($str, 'eq', $expected, 'fields handling');
 211
 212         $str = $changes->format_range('dpkg', { offset => 1, count => 2 });
 213         $expected = 'Source: fields
 214 Version: 2.0-1
 215 Distribution: unstable frozen
 216 Urgency: medium
 217 Maintainer: Frank Lichtenheld <djpig@debian.org>
 218 Timestamp: 1200149359
 219 Date: Sun, 12 Jan 2008 15:49:19 +0100
 220 Closes: 1111111 2222222
 221 Changes:
 222  fields (2.0-1) unstable  frozen; urgency=medium
 223  .
 224    [ Frank Lichtenheld ]
 225    * Upload to unstable (Closes: #1111111, #2222222)
 226    * Fix stuff. (LP: #12345, #424242)
 227  .
 228    [ Raphaël Hertzog ]
 229    * New upstream release.
 230      - implements a
 231      - implements b
 232    * Update S-V.
 233  .
 234  fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
 235  .
 236    * Beta
 237 Xc-Userfield: foobar
 238
 239 ';
 240         if ($vendor eq 'Ubuntu') {
 241             $expected =~ s/^(Closes:.*)/$1\nLaunchpad-Bugs-Fixed: 12345 424242/m;
 242         }
 243         cmp_ok($str, 'eq', $expected, 'fields handling 2');
 244
 245         $str = $changes->format_range('rfc822', { offset => 2, count => 2 });
 246         $expected = 'Source: fields
 247 Version: 2.0~b1-1
 248 Distribution: unstable
 249 Urgency: low
 250 Maintainer: Frank Lichtenheld <frank@lichtenheld.de>
 251 Timestamp: 1200062959
 252 Date: Sun, 11 Jan 2008 15:49:19 +0100
 253 Changes:
 254  fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
 255  .
 256    * Beta
 257 Xc-Userfield: foobar
 258
 259 Source: fields
 260 Version: 1.0
 261 Distribution: experimental
 262 Urgency: high
 263 Maintainer: Frank Lichtenheld <djpig@debian.org>
 264 Timestamp: 1199976559
 265 Date: Sun, 10 Jan 2008 15:49:19 +0100
 266 Closes: 1000000
 267 Changes:
 268  fields (1.0) experimental; urgency=high,xb-userfield2=foobar
 269  .
 270    * First upload (Closes: #1000000)
 271 Xb-Userfield2: foobar
 272
 273 ';
 274         cmp_ok($str, 'eq', $expected, 'fields handling 3');
 275
 276         # Test Dpkg::Changelog::Entry methods
 277         is($data[1]->get_version(), '2.0-1', 'get_version');
 278         is($data[1]->get_source(), 'fields', 'get_source');
 279         is(scalar $data[1]->get_distributions(), 'unstable', 'get_distribution');
 280         is(join('|', $data[1]->get_distributions()), 'unstable|frozen',
 281             'get_distributions');
 282         is($data[3]->get_optional_fields(),
 283             "Urgency: high\nCloses: 1000000\nXb-Userfield2: foobar\n",
 284             'get_optional_fields');
 285         is($data[1]->get_maintainer(), 'Frank Lichtenheld <djpig@debian.org>',
 286             'get_maintainer');
 287         is($data[1]->get_timestamp(), 'Sun, 12 Jan 2008 15:49:19 +0100',
 288             'get_timestamp');
 289         my @items = $data[1]->get_change_items();
 290         is($items[0], "  [ Frank Lichtenheld ]\n", 'change items 1');
 291         is($items[4], '  * New upstream release.
 292     - implements a
 293     - implements b
 294 ', 'change items 2');
 295         is($items[5], "  * Update S-V.\n", 'change items 3');
 296     }
 297     if ($file eq "$datadir/date-format") {
 298         is($data[0]->get_timestamp(), '01 Jul 2100 23:59:59 -1200',
 299            'get date w/o DoW, and negative timezone offset');
 300         is($data[1]->get_timestamp(), 'Tue, 27 Feb 2050 12:00:00 +1245',
 301            'get date w/ DoW, and positive timezone offset');
 302         is($data[2]->get_timestamp(), 'Mon, 01 Jan 2000 00:00:00 +0000',
 303            'get date w/ DoW, and zero timezone offset');
 304     }
 305     if ($file eq "$datadir/regressions") {
 306         my $f = ($changes->format_range('dpkg'))[0];
 307         is("$f->{Version}", '0', 'version 0 correctly parsed');
 308     }
 309
 310     SKIP: {
 311         skip('avoid spurious warning with only one entry', 2)
 312             if @data == 1;
 313
 314         my $oldest_version = $data[-1]->{Version};
 315         $str = $changes->format_range('dpkg', { since => $oldest_version });
 316
 317         $str = $changes->format_range('rfc822');
 318
 319         ok(1, 'TODO check rfc822 output');
 320
 321         $str = $changes->format_range('rfc822', { since => $oldest_version });
 322
 323         ok(1, 'TODO check rfc822 output with ranges');
 324     }
 325 }
 326
 327 foreach my $test (([ "$datadir/misplaced-tz", 6 ],
 328                    [ "$datadir/unreleased", 5, 7 ])) {
 329
 330     my $file = shift @$test;
 331     my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
 332     $changes->load($file);
 333     my @errors = $changes->get_parse_errors();
 334
 335     ok(@errors, 'errors occured');
 336     is_deeply( [ map { $_->[1] } @errors ], $test, 'check line numbers' );
 337 }