chiark - git - mdw - dpkg/blob - scripts/t/dpkg_source.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 => 8;
  20 use Test::Dpkg qw(test_neutralize_checksums);
  21
  22 use File::Spec::Functions qw(rel2abs);
  23 use File::Compare;
  24 use File::Path qw(make_path);
  25
  26 use Dpkg::IPC;
  27 use Dpkg::Substvars;
  28
  29 my $srcdir = rel2abs($ENV{srcdir} || '.');
  30 my $datadir = "$srcdir/t/dpkg_source";
  31 my $tmpdir = 't.tmp/dpkg_source';
  32
  33 $ENV{$_} = rel2abs($ENV{$_}) foreach qw(DPKG_DATADIR DPKG_ORIGINS_DIR);
  34
  35 # Delete variables that can affect the tests.
  36 delete $ENV{SOURCE_DATE_EPOCH};
  37
  38 make_path($tmpdir);
  39
  40 chdir $tmpdir;
  41
  42 my $tmpl_format = <<'TMPL_FORMAT';
  43 3.0 (native)
  44 TMPL_FORMAT
  45
  46 my $tmpl_changelog = <<'TMPL_CHANGELOG';
  47 ${source-name} (${source-version}) ${suite}; urgency=${urgency}
  48
  49   * Test package.
  50
  51  -- ${maintainer}  Sat, 05 Jul 2014 21:11:22 +0200
  52 TMPL_CHANGELOG
  53
  54 my $tmpl_control = <<'TMPL_CONTROL';
  55 Source: ${source-name}
  56 Section: ${source-section}
  57 Priority: ${source-priority}
  58 Maintainer: ${maintainer}
  59 Standards-Version: 1.0
  60 Testsuite: ${source-testsuite}
  61
  62 Package: test-binary
  63 Architecture: all
  64 Description: test package
  65 TMPL_CONTROL
  66
  67 my %default_substvars = (
  68     'source-name' => 'test-source',
  69     'source-version' => 0,
  70     'source-section' => 'test',
  71     'source-priority' => 'optional',
  72     'source-testsuite' => 'autopkgtest',
  73     'suite' => 'unstable',
  74     'urgency' => 'low',
  75     'maintainer' => 'Dpkg Developers <debian-dpkg@lists.debian.org>',
  76 );
  77
  78 sub gen_from_tmpl
  79 {
  80     my ($pathname, $tmpl, $substvars) = @_;
  81
  82     open my $fh, '>', $pathname or die;
  83     print { $fh } $substvars->substvars($tmpl);
  84     close $fh or die;
  85 }
  86
  87 sub gen_source
  88 {
  89     my (%options) = @_;
  90
  91     my $substvars = Dpkg::Substvars->new();
  92     foreach my $var ((keys %default_substvars, keys %options)) {
  93         my $value = $options{$var} // $default_substvars{$var};
  94
  95         $substvars->set_as_auto($var, $value);
  96     }
  97
  98     my $source = $substvars->get('source-name');
  99     my $version = $substvars->get('source-version');
 100     my $dirname = "$source-$version";
 101
 102     make_path("$dirname/debian/source");
 103
 104     gen_from_tmpl("$dirname/debian/source/format", $tmpl_format, $substvars);
 105     gen_from_tmpl("$dirname/debian/changelog", $tmpl_changelog, $substvars);
 106     gen_from_tmpl("$dirname/debian/control", $tmpl_control, $substvars);
 107
 108     if (defined $options{'control-test'}) {
 109         make_path("$dirname/debian/tests");
 110         gen_from_tmpl("$dirname/debian/tests/control", $options{'control-test'}, $substvars);
 111     }
 112
 113     return $dirname;
 114 }
 115
 116 sub test_diff
 117 {
 118     my $filename = shift;
 119
 120     my $expected_file = "$datadir/$filename";
 121     my $generated_file =  $filename;
 122
 123     test_neutralize_checksums($generated_file);
 124
 125     my $res = compare($expected_file, $generated_file);
 126     if ($res) {
 127         system "diff -u $expected_file $generated_file >&2";
 128     }
 129     ok($res == 0, "generated file matches expected one ($expected_file)");
 130 }
 131
 132 sub test_build_source
 133 {
 134     my ($name) = shift;
 135     my $stderr;
 136
 137     spawn(exec => [ $ENV{PERL}, "$srcdir/dpkg-source.pl", '--build', $name ],
 138           error_to_string => \$stderr,
 139           wait_child => 1, nocheck => 1);
 140
 141     ok($? == 0, 'dpkg-source --build succeeded');
 142     diag($stderr) unless $? == 0;
 143
 144     my $basename = $name =~ tr/-/_/r;
 145
 146     test_diff("$basename.dsc");
 147 }
 148
 149 my $dirname;
 150
 151 $dirname = gen_source('source-name' => 'testsuite',
 152                       'source-version' => 0,
 153                       'control-test' => '');
 154 test_build_source($dirname);
 155
 156 $dirname = gen_source('source-name' => 'testsuite',
 157                       'source-version' => 1,
 158                       'control-test' => '');
 159 test_build_source($dirname);
 160
 161 $dirname = gen_source('source-name' => 'testsuite',
 162                       'source-version' => 2,
 163                       'source-testsuite' => 'smokepkgtest, unitpkgtest, funcpkgtest',
 164                       'control-test' => '');
 165 test_build_source($dirname);
 166
 167 $dirname = gen_source('source-name' => 'testsuite',
 168                       'source-version' => 3);
 169 test_build_source($dirname);
 170
 171 1;