600_Dpkg_Changelog.t 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313
  1. # -*- 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 <http://www.gnu.org/licenses/>.
  15. use strict;
  16. use warnings;
  17. use File::Basename;
  18. BEGIN {
  19. my $no_examples = 4;
  20. my $no_err_examples = 1;
  21. my $no_tests = $no_examples * 5
  22. + $no_err_examples * 2
  23. + 26 # countme
  24. + 13 # fields
  25. + 21;
  26. require Test::More;
  27. import Test::More tests => $no_tests;
  28. }
  29. BEGIN {
  30. use_ok('Dpkg::Changelog');
  31. use_ok('Dpkg::Changelog::Debian');
  32. };
  33. my $srcdir = $ENV{srcdir} || '.';
  34. my $datadir = $srcdir . '/t/600_Dpkg_Changelog';
  35. #########################
  36. foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
  37. "$datadir/regressions") {
  38. my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
  39. $changes->load($file);
  40. open(CLOG, "<", "$file") || die "Can't open $file\n";
  41. my $content = join("", <CLOG>);
  42. close(CLOG);
  43. cmp_ok($content, 'eq', "$changes", "string output of Dpkg::Changelog on $file");
  44. my $errors = $changes->get_parse_errors();
  45. my $basename = basename( $file );
  46. is($errors, '', "Parse example changelog $file without errors" );
  47. my @data = @$changes;
  48. ok(@data, "data is not empty");
  49. my $str;
  50. if ($file eq "$datadir/countme") {
  51. # test range options
  52. cmp_ok( @data, '==', 7, "no options -> count" );
  53. my $all_versions = join( '/', map { $_->get_version() } @data);
  54. sub check_options {
  55. my ($changes, $data, $options, $count, $versions,
  56. $check_name) = @_;
  57. my @cnt = $changes->get_range($options);
  58. cmp_ok( @cnt, '==', $count, "$check_name -> count" );
  59. if ($count == @$data) {
  60. is_deeply( \@cnt, $data, "$check_name -> returns all" );
  61. } else {
  62. is( join( "/", map { $_->get_version() } @cnt),
  63. $versions, "$check_name -> versions" );
  64. }
  65. }
  66. check_options( $changes, \@data,
  67. { count => 3 }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
  68. 'positive count' );
  69. check_options( $changes, \@data,
  70. { count => -3 }, 3,
  71. '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
  72. 'negative count' );
  73. check_options( $changes, \@data,
  74. { count => 1 }, 1, '2:2.0-1',
  75. 'count 1' );
  76. check_options( $changes, \@data,
  77. { count => 1, default_all => 1 }, 1, '2:2.0-1',
  78. 'count 1 (d_a 1)' );
  79. check_options( $changes, \@data,
  80. { count => -1 }, 1, '1.5-1',
  81. 'count -1' );
  82. check_options( $changes, \@data,
  83. { count => 3, offset => 2 }, 3,
  84. '1:2.0~rc2-2/1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2',
  85. 'positve count + positive offset' );
  86. check_options( $changes, \@data,
  87. { count => -3, offset => 4 }, 3,
  88. '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
  89. 'negative count + positive offset' );
  90. check_options( $changes, \@data,
  91. { count => 4, offset => 5 }, 2,
  92. '1:2.0~rc2-1sarge1/1.5-1',
  93. 'positve count + positive offset (>max)' );
  94. check_options( $changes, \@data,
  95. { count => -4, offset => 2 }, 2,
  96. '2:2.0-1/1:2.0~rc2-3',
  97. 'negative count + positive offset (<0)' );
  98. check_options( $changes, \@data,
  99. { count => 3, offset => -4 }, 3,
  100. '1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1',
  101. 'positve count + negative offset' );
  102. check_options( $changes, \@data,
  103. { count => -3, offset => -3 }, 3,
  104. '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
  105. 'negative count + negative offset' );
  106. check_options( $changes, \@data,
  107. { count => 5, offset => -2 }, 2,
  108. '1:2.0~rc2-1sarge1/1.5-1',
  109. 'positve count + negative offset (>max)' );
  110. check_options( $changes, \@data,
  111. { count => -5, offset => -4 }, 3,
  112. '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
  113. 'negative count + negative offset (<0)' );
  114. check_options( $changes, \@data,
  115. { count => 7 }, 7, '',
  116. 'count 7 (max)' );
  117. check_options( $changes, \@data,
  118. { count => -7 }, 7, '',
  119. 'count -7 (-max)' );
  120. check_options( $changes, \@data,
  121. { count => 10 }, 7, '',
  122. 'count 10 (>max)' );
  123. check_options( $changes, \@data,
  124. { count => -10 }, 7, '',
  125. 'count -10 (<-max)' );
  126. check_options( $changes, \@data,
  127. { from => '1:2.0~rc2-1sarge3' }, 4,
  128. '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
  129. 'from => "1:2.0~rc2-1sarge3"' );
  130. check_options( $changes, \@data,
  131. { since => '1:2.0~rc2-1sarge3' }, 3,
  132. '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
  133. 'since => "1:2.0~rc2-1sarge3"' );
  134. $SIG{'__WARN__'} = sub {};
  135. check_options( $changes, \@data,
  136. { since => 0 }, 7, '',
  137. 'since => 0 returns all');
  138. delete $SIG{'__WARN__'};
  139. check_options( $changes, \@data,
  140. { to => '1:2.0~rc2-1sarge2' }, 3,
  141. '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
  142. 'to => "1:2.0~rc2-1sarge2"' );
  143. check_options( $changes, \@data,
  144. { until => '1:2.0~rc2-1sarge2' }, 2,
  145. '1:2.0~rc2-1sarge1/1.5-1',
  146. 'until => "1:2.0~rc2-1sarge2"' );
  147. #TODO: test combinations
  148. }
  149. if ($file eq "$datadir/fields") {
  150. my $str = $changes->dpkg({ all => 1 });
  151. my $expected = 'Source: fields
  152. Version: 2.0-0etch1
  153. Distribution: stable
  154. Urgency: high
  155. Maintainer: Frank Lichtenheld <frank@lichtenheld.de>
  156. Date: Sun, 13 Jan 2008 15:49:19 +0100
  157. Closes: 1000000 1111111 2222222
  158. Changes:
  159. fields (2.0-0etch1) stable; urgency=low
  160. .
  161. * Upload to stable (Closes: #1111111, #2222222)
  162. .
  163. fields (2.0-1) unstable frozen; urgency=medium
  164. .
  165. [ Frank Lichtenheld ]
  166. * Upload to unstable (Closes: #1111111, #2222222)
  167. .
  168. [ Raphaël Hertzog ]
  169. * New upstream release.
  170. - implements a
  171. - implements b
  172. * Update S-V.
  173. .
  174. fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
  175. .
  176. * Beta
  177. .
  178. fields (1.0) experimental; urgency=high,xb-userfield2=foobar
  179. .
  180. * First upload (Closes: #1000000)
  181. Xb-Userfield2: foobar
  182. Xc-Userfield: foobar
  183. ';
  184. cmp_ok($str,'eq',$expected,"fields handling");
  185. $str = $changes->dpkg({ offset => 1, count => 2 });
  186. $expected = 'Source: fields
  187. Version: 2.0-1
  188. Distribution: unstable frozen
  189. Urgency: medium
  190. Maintainer: Frank Lichtenheld <djpig@debian.org>
  191. Date: Sun, 12 Jan 2008 15:49:19 +0100
  192. Closes: 1111111 2222222
  193. Changes:
  194. fields (2.0-1) unstable frozen; urgency=medium
  195. .
  196. [ Frank Lichtenheld ]
  197. * Upload to unstable (Closes: #1111111, #2222222)
  198. .
  199. [ Raphaël Hertzog ]
  200. * New upstream release.
  201. - implements a
  202. - implements b
  203. * Update S-V.
  204. .
  205. fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
  206. .
  207. * Beta
  208. Xc-Userfield: foobar
  209. ';
  210. cmp_ok($str,'eq',$expected,"fields handling 2");
  211. $str = $changes->rfc822({ offset => 2, count => 2 });
  212. $expected = 'Source: fields
  213. Version: 2.0~b1-1
  214. Distribution: unstable
  215. Urgency: low
  216. Maintainer: Frank Lichtenheld <frank@lichtenheld.de>
  217. Date: Sun, 11 Jan 2008 15:49:19 +0100
  218. Changes:
  219. fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
  220. .
  221. * Beta
  222. Xc-Userfield: foobar
  223. Source: fields
  224. Version: 1.0
  225. Distribution: experimental
  226. Urgency: high
  227. Maintainer: Frank Lichtenheld <djpig@debian.org>
  228. Date: Sun, 10 Jan 2008 15:49:19 +0100
  229. Closes: 1000000
  230. Changes:
  231. fields (1.0) experimental; urgency=high,xb-userfield2=foobar
  232. .
  233. * First upload (Closes: #1000000)
  234. Xb-Userfield2: foobar
  235. ';
  236. cmp_ok($str, 'eq', $expected, "fields handling 3");
  237. # Test Dpkg::Changelog::Entry methods
  238. is($data[1]->get_version(), "2.0-1", "get_version");
  239. is($data[1]->get_source(), "fields", "get_source");
  240. is(scalar $data[1]->get_distributions(), "unstable", "get_distribution");
  241. is(join("|", $data[1]->get_distributions()), "unstable|frozen",
  242. "get_distributions");
  243. is($data[3]->get_optional_fields(),
  244. "Urgency: high\nCloses: 1000000\nXb-Userfield2: foobar\n",
  245. "get_optional_fields");
  246. is($data[1]->get_maintainer(), 'Frank Lichtenheld <djpig@debian.org>',
  247. "get_maintainer");
  248. is($data[1]->get_timestamp(), 'Sun, 12 Jan 2008 15:49:19 +0100',
  249. "get_timestamp");
  250. my @items = $data[1]->get_change_items();
  251. is($items[0], " [ Frank Lichtenheld ]\n", "change items 1");
  252. is($items[3], " * New upstream release.
  253. - implements a
  254. - implements b
  255. ", "change items 2");
  256. is($items[4], " * Update S-V.\n", "change items 3");
  257. }
  258. SKIP: {
  259. skip("avoid spurious warning with only one entry", 2)
  260. if @data == 1;
  261. my $oldest_version = $data[-1]->{Version};
  262. $str = $changes->dpkg({ since => $oldest_version });
  263. $str = $changes->rfc822();
  264. ok( 1 );
  265. $str = $changes->rfc822({ since => $oldest_version });
  266. ok( 1 );
  267. }
  268. }
  269. foreach my $test (( [ "$datadir/misplaced-tz", 6 ])) {
  270. my $file = shift @$test;
  271. my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
  272. $changes->load($file);
  273. my @errors = $changes->get_parse_errors();
  274. ok(@errors, 'errors occured');
  275. is_deeply( [ map { $_->[1] } @errors ], $test, 'check line numbers' );
  276. }