Commit | Line | Data |
---|---|---|
1479465f GJ |
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; |