Subject: [PATCH 4/5] Test for correct Unpack-Level values

From: Raphael Geissert <[email-masked]>
Date: Sat, 2 May 2009 14:36:12 -0500

---
 checks/debhelper.desc    |    2 +-
 checks/menu-format.desc  |    2 +-
 checks/menus.desc        |    2 +-
 checks/po-debconf.desc   |    2 +-
 t/scripts/unpack-level.t |   63 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 67 insertions(+), 4 deletions(-)
 create mode 100644 t/scripts/unpack-level.t

diff --git a/checks/debhelper.desc b/checks/debhelper.desc
index 268dae2..b8805e8 100644
--- a/checks/debhelper.desc
+++ b/checks/debhelper.desc
@@ -2,7 +2,7 @@ Check-Script: debhelper
 Author: Joey Hess <[email-masked]>
 Abbrev: dh
 Type: source
-Unpack-Level: 2
+Unpack-Level: 1
 Info: This looks for common mistakes in debhelper source packages.
 Needs-Info: debfiles, source-control-file
 
diff --git a/checks/menu-format.desc b/checks/menu-format.desc
index ae5db97..416123f 100644
--- a/checks/menu-format.desc
+++ b/checks/menu-format.desc
@@ -3,7 +3,7 @@ Author: Joey Hess <[email-masked]>
 Abbrev: mnf
 Needs-Info: menu-files
 Type: binary
-Unpack-Level: 1
+Unpack-Level: 2
 Info: This script validates the format of menu files.
 
 Tag: old-format-menu-file
diff --git a/checks/menus.desc b/checks/menus.desc
index 517c514..6043add 100644
--- a/checks/menus.desc
+++ b/checks/menus.desc
@@ -2,7 +2,7 @@ Check-Script: menus
 Author: Christian Schwarz <[email-masked]>
 Abbrev: men
 Type: binary
-Unpack-Level: 1
+Unpack-Level: 2
 Needs-Info: doc-base-files
 
 Tag: postinst-should-not-set-usr-doc-link
diff --git a/checks/po-debconf.desc b/checks/po-debconf.desc
index 6707793..bd8d41a 100644
--- a/checks/po-debconf.desc
+++ b/checks/po-debconf.desc
@@ -2,7 +2,7 @@ Check-Script: po-debconf
 Author: Denis Barbier <[email-masked]>
 Abbrev: pd
 Type: source
-Unpack-Level: 2
+Unpack-Level: 1
 Info: This looks for common mistakes in packages using po-debconf.
 Needs-Info: debfiles
 
diff --git a/t/scripts/unpack-level.t b/t/scripts/unpack-level.t
new file mode 100644
index 0000000..0b0abf3
--- /dev/null
+++ b/t/scripts/unpack-level.t
@@ -0,0 +1,63 @@
+#!/usr/bin/perl -w
+
+# Copyright (C) 2009 by Raphael Geissert <[email-masked]>
+# Copyright (C) 2009 Russ Allbery <[email-masked]>
+#
+# This file is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# This file is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this file.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+
+use Test::More;
+use Util qw(read_dpkg_control slurp_entire_file);
+
+# Find all of the desc files in either collection or checks.  We'll do one
+# check per description.
+our @DESCS = (<$ENV{LINTIAN_ROOT}/collection/*.desc>,
+              <$ENV{LINTIAN_ROOT}/checks/*.desc>);
+plan tests => scalar(@DESCS);
+
+my @l2refs = (
+	qr<unpacked/>,
+	qr<unpacked-errors>,
+	qr<chdir\s*\(\s*["']unpacked/?['"]\s*\)>,
+);
+
+# For each desc file, load the first stanza of the file and check that if
+# the unpack level is one no reference to unpack/ should be made, and if
+# it is level two then there should be a reference
+for my $desc (@DESCS) {
+    my ($header) = read_dpkg_control($desc);
+
+    if ($desc =~ m/lintian\.desc$/) {
+	ok(1, "lintian.desc has valid unpack-level");
+	next;
+    }
+
+    my $level = $header->{'unpack-level'};
+    chomp $level;
+    my ($file) = split(/\.desc$/, $desc);
+    my $code = slurp_entire_file($file);
+    my $requiredlevel = 1;
+
+    for my $l2ref (@l2refs) {
+	if ($code =~ m/$l2ref/) {
+	    $requiredlevel = 2;
+	    last;
+	}
+    }
+    my $short = $desc;
+    $short =~ s/^\Q$ENV{LINTIAN_ROOT}//;
+
+    ok($level eq $requiredlevel, "$short has valid unpack-level ($level eq $requiredlevel)");
+}