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