Merge branch 'master' into core-updates

6 files changed, 477 insertions, 6 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 64c3107ef7..709a198e1e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -89,6 +90,36 @@
 
 (test-begin "gexp")
 
+(test-equal "no references"
+  '(display "hello gexp->approximate-sexp!")
+  (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!")))
+
+(test-equal "unquoted gexp"
+  '(display "hello")
+  (let ((inside #~"hello"))
+    (gexp->approximate-sexp #~(display #$inside))))
+
+(test-equal "unquoted gexp (native)"
+  '(display "hello")
+  (let ((inside #~"hello"))
+    (gexp->approximate-sexp #~(display #+inside))))
+
+(test-equal "spliced gexp"
+  '(display '(fresh vegetables))
+  (let ((inside #~(fresh vegetables)))
+    (gexp->approximate-sexp #~(display '(#$@inside)))))
+
+(test-equal "unspliced gexp, approximated"
+  ;; (*approximate*) is really an implementation detail
+  '(display '(*approximate*))
+  (let ((inside (file-append coreutils "/bin/hello")))
+    (gexp->approximate-sexp #~(display '(#$@inside)))))
+
+(test-equal "unquoted gexp, approximated"
+  '(display '(*approximate*))
+  (let ((inside (file-append coreutils "/bin/hello")))
+    (gexp->approximate-sexp #~(display '#$inside))))
+
 (test-equal "no refs"
   '(display "hello!")
   (let ((exp (gexp (display "hello!"))))
diff --git a/tests/go.scm b/tests/go.scm
index b088ab50d2..6749f4585f 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,9 @@
   #:use-module (srfi srfi-64)
   #:use-module (web response))
 
+(define go.mod-requirements
+  (@@ (guix import go) go.mod-requirements))
+
 (define parse-go.mod
   (@@ (guix import go) parse-go.mod))
 
@@ -57,7 +61,6 @@ require (
 exclude D v1.2.3
 ")
 
-
 (define fixture-go-mod-complete
   "module M
 
@@ -96,11 +99,40 @@ replace (
 
 ")
 
+(define fixture-go-mod-unparseable
+  "module my/thing
+go 1.12 // avoid feature X
+require other/thing v1.0.2
+// Security issue: CVE-XXXXX
+exclude old/thing v1.2.3
+new-directive another/thing yet-another/thing
+replace (
+        bad/thing v1.4.5 => good/thing v1.4.5
+        // Unparseable
+        bad/thing [v1.4.5, v1.9.7] => good/thing v2.0.0
+)
+")
 
+(define fixture-go-mod-retract
+  "retract v0.9.1
 
-(define fixture-latest-for-go-check
-  "{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}")
+retract (
+	v1.9.2
+	[v1.0.0, v1.7.9]
+)
+")
 
+(define fixture-go-mod-strings
+  "require `example.com/\"some-repo\"` v1.9.3
+require (
+        `example.com/\"another.repo\"` v1.0.0
+        \"example.com/special!repo\" v9.3.1
+)
+replace \"example.com/\\\"some-repo\\\"\" => `launchpad.net/some-repo` v1.9.3
+replace (
+        \"example.com/\\\"another.repo\\\"\" => launchpad.net/another-repo v1.0.0
+)
+")
 
 (define fixtures-go-check-test
   (let ((version
@@ -185,7 +217,7 @@ require github.com/kr/pretty v0.2.1
     (string<? (car p1) (car p2)))
   (test-equal name
     (sort expected inf?)
-    (sort ((@@ (guix import go) parse-go.mod) input) inf?)))
+    (sort (go.mod-requirements (parse-go.mod input)) inf?)))
 
 (testing-parse-mod "parse-go.mod-simple"
                    '(("good/thing" "v1.4.5")
@@ -221,6 +253,98 @@ require github.com/kr/pretty v0.2.1
    ("github.com/go-check/check" "v0.0.0-20140225173054-eb6ee6f84d0a"))
  fixture-go-mod-complete)
 
+(test-equal "parse-go.mod: simple"
+  `((module (module-path "my/thing"))
+    (go (version "1.12"))
+    (require (module-path "other/thing") (version "v1.0.2"))
+    (require (module-path "new/thing/v2") (version "v2.3.4"))
+    (exclude (module-path "old/thing") (version "v1.2.3"))
+    (replace (original (module-path "bad/thing") (version "v1.4.5"))
+      (with (module-path "good/thing") (version "v1.4.5"))))
+  (parse-go.mod fixture-go-mod-simple))
+
+(test-equal "parse-go.mod: comments and unparseable lines"
+  `((module (module-path "my/thing"))
+    (go (version "1.12") (comment "avoid feature X"))
+    (require (module-path "other/thing") (version "v1.0.2"))
+    (comment "Security issue: CVE-XXXXX")
+    (exclude (module-path "old/thing") (version "v1.2.3"))
+    (unknown "new-directive another/thing yet-another/thing")
+    (replace (original (module-path "bad/thing") (version "v1.4.5"))
+      (with (module-path "good/thing") (version "v1.4.5")))
+    (comment "Unparseable")
+    (unknown "bad/thing [v1.4.5, v1.9.7] => good/thing v2.0.0"))
+  (parse-go.mod fixture-go-mod-unparseable))
+
+(test-equal "parse-go.mod: retract"
+  `((retract (version "v0.9.1"))
+    (retract (version "v1.9.2"))
+    (retract (range (version "v1.0.0") (version "v1.7.9"))))
+  (parse-go.mod fixture-go-mod-retract))
+
+(test-equal "parse-go.mod: raw strings and quoted strings"
+  `((require (module-path "example.com/\"some-repo\"") (version "v1.9.3"))
+    (require (module-path "example.com/\"another.repo\"") (version "v1.0.0"))
+    (require (module-path "example.com/special!repo") (version "v9.3.1"))
+    (replace (original (module-path "example.com/\"some-repo\""))
+      (with (module-path "launchpad.net/some-repo") (version "v1.9.3")))
+    (replace (original (module-path "example.com/\"another.repo\""))
+      (with (module-path "launchpad.net/another-repo") (version "v1.0.0"))))
+  (parse-go.mod fixture-go-mod-strings))
+
+(test-equal "parse-go.mod: complete"
+  `((module (module-path "M"))
+    (go (version "1.13"))
+    (replace (original (module-path "github.com/myname/myproject/myapi"))
+      (with (file-path "./api")))
+    (replace (original (module-path "github.com/mymname/myproject/thissdk"))
+      (with (file-path "../sdk")))
+    (replace (original (module-path "launchpad.net/gocheck"))
+      (with (module-path "github.com/go-check/check")
+            (version "v0.0.0-20140225173054-eb6ee6f84d0a")))
+    (require (module-path "github.com/user/project")
+             (version "v1.1.11"))
+    (require (module-path "github.com/user/project/sub/directory")
+             (version "v1.1.12"))
+    (require (module-path "bitbucket.org/user/project")
+             (version "v1.11.20"))
+    (require (module-path "bitbucket.org/user/project/sub/directory")
+             (version "v1.11.21"))
+    (require (module-path "launchpad.net/project")
+             (version "v1.1.13"))
+    (require (module-path "launchpad.net/project/series")
+             (version "v1.1.14"))
+    (require (module-path "launchpad.net/project/series/sub/directory")
+             (version "v1.1.15"))
+    (require (module-path "launchpad.net/~user/project/branch")
+             (version "v1.1.16"))
+    (require (module-path "launchpad.net/~user/project/branch/sub/directory")
+             (version "v1.1.17"))
+    (require (module-path "hub.jazz.net/git/user/project")
+             (version "v1.1.18"))
+    (require (module-path "hub.jazz.net/git/user/project/sub/directory")
+             (version "v1.1.19"))
+    (require (module-path "k8s.io/kubernetes/subproject")
+             (version "v1.1.101"))
+    (require (module-path "one.example.com/abitrary/repo")
+             (version "v1.1.111"))
+    (require (module-path "two.example.com/abitrary/repo")
+             (version "v0.0.2"))
+    (require (module-path "quoted.example.com/abitrary/repo")
+             (version "v0.0.2"))
+    (replace (original (module-path "two.example.com/abitrary/repo"))
+      (with (module-path "github.com/corp/arbitrary-repo")
+            (version "v0.0.2")))
+    (replace (original (module-path "golang.org/x/sys"))
+      (with (module-path "golang.org/x/sys")
+            (version "v0.0.0-20190813064441-fde4db37ae7a"))
+      (comment "pinned to release-branch.go1.13"))
+    (replace (original (module-path "golang.org/x/tools"))
+      (with (module-path "golang.org/x/tools")
+            (version "v0.0.0-20190821162956-65e3620a7ae7"))
+      (comment "pinned to release-branch.go1.13")))
+  (parse-go.mod fixture-go-mod-complete))
+
 ;;; End-to-end tests for (guix import go)
 (define (mock-http-fetch testcase)
   (lambda (url . rest)
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 66a13d9881..53972fc643 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -388,4 +388,46 @@ executable cabal
      #t)
     (x (pk 'fail x #f))))
 
+(define test-cabal-import
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+common commons
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+
+executable cabal
+  import: commons
+")
+
+(define-package-matcher match-ghc-foo-import
+  ('package
+    ('name "ghc-foo")
+    ('version "1.0.0")
+    ('source
+     ('origin
+       ('method 'url-fetch)
+       ('uri ('string-append
+              "https://hackage.haskell.org/package/foo/foo-"
+              'version
+              ".tar.gz"))
+       ('sha256
+        ('base32
+         (? string? hash)))))
+    ('build-system 'haskell-build-system)
+    ('inputs
+     ('quasiquote
+      (("ghc-http" ('unquote 'ghc-http)))))
+    ('home-page "http://test.org")
+    ('synopsis (? string?))
+    ('description (? string?))
+    ('license 'license:bsd-3)))
+
+(test-assert "hackage->guix-package test cabal import"
+  (eval-test-with-cabal test-cabal-import match-ghc-foo-import))
+
 (test-end "hackage")
diff --git a/tests/lint.scm b/tests/lint.scm
index 0a8f1c6f54..dfb45ef60d 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -8,7 +8,9 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,7 +40,7 @@
   #:use-module (guix lint)
   #:use-module (guix ui)
   #:use-module (guix swh)
-  #:use-module ((guix gexp) #:select (local-file))
+  #:use-module ((guix gexp) #:select (gexp local-file gexp?))
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module ((guix import hackage) #:select (%hackage-url))
   #:use-module ((guix import stackage) #:select (%stackage-url))
@@ -46,6 +48,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python-xyz)
+  #:use-module ((gnu packages bash) #:select (bash bash-minimal))
   #:use-module (web uri)
   #:use-module (web server)
   #:use-module (web server http)
@@ -160,6 +163,13 @@
                              (description "This is a 'quoted' thing."))))
      (check-description-style pkg))))
 
+(test-equal "description: leading whitespace"
+  "description contains leading whitespace"
+  (single-lint-warning-message
+   (let ((pkg (dummy-package "x"
+                              (description " Whitespace."))))
+     (check-description-style pkg))))
+
 (test-equal "description: trailing whitespace"
   "description contains trailing whitespace"
   (single-lint-warning-message
@@ -370,6 +380,92 @@
                           ("pkgkonfig" ,pkg-config))))))
      (check-input-labels pkg))))
 
+(test-equal "explicit #:sh argument to 'wrap-program' is acceptable"
+  '()
+  (let* ((phases
+          ;; Loosely based on the "catfish" package
+          `(modify-phases %standard-phases
+             (add-after 'install 'wrap
+               (lambda* (#:key inputs outputs #:allow-other-keys)
+                 (define catfish (string-append (assoc-ref outputs "out")
+                                                "/bin/catfish"))
+                 (define hsab (string-append (assoc-ref inputs "hsab")
+                                             "/bin/hsab"))
+                 (wrap-program catfish #:sh hsab
+                               `("PYTHONPATH" = (,"blabla")))))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
+    (check-wrapper-inputs pkg)))
+
+(test-equal
+    "'check-wrapper-inputs' detects 'wrap-program' without \"bash\" in inputs"
+  "\"bash-minimal\" should be in 'inputs' when 'wrap-program' is used"
+  (let* ((phases
+          `(modify-phases %standard-phases
+             (add-after 'install 'wrap
+               (lambda _
+                 (wrap-program the-binary bla-bla)))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
+    (single-lint-warning-message (check-wrapper-inputs pkg))))
+
+(test-equal
+    "'check-wrapper-inputs' detects 'wrap-qt-program' without \"bash\" in inputs"
+  "\"bash-minimal\" should be in 'inputs' when 'wrap-qt-program' is used"
+  (let* ((phases
+          `(modify-phases %standard-phases
+             (add-after 'install 'qtwrap
+               (lambda _
+                 (wrap-qt-program the-binary bla-bla)))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
+    (single-lint-warning-message (check-wrapper-inputs pkg))))
+
+(test-equal "\"bash\" in 'inputs' satisfies 'check-wrapper-inputs'"
+  '()
+  (let* ((phases
+          `(modify-phases %standard-phases
+             (add-after 'install 'wrap
+               (lambda _
+                 (wrap-program the-binary bla-bla)))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases))
+                             (inputs `(("bash" ,bash))))))
+    (check-wrapper-inputs pkg)))
+
+(test-equal "\"bash-minimal\" in 'inputs' satisfies 'check-wrapper-inputs'"
+  '()
+  (let* ((phases
+          `(modify-phases %standard-phases
+             (add-after 'install 'wrap
+               (lambda _
+                 (wrap-program THE-BINARY bla-bla)))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases))
+                             (inputs `(("bash-minimal" ,bash-minimal))))))
+    (check-wrapper-inputs pkg)))
+
+(test-equal "'cut' doesn't hide bad usages of 'wrap-program'"
+  "\"bash-minimal\" should be in 'inputs' when 'wrap-program' is used"
+  (let* ((phases
+          ;; Taken from the "straw-viewer" package
+          `(modify-phases %standard-phases
+             (add-after 'install 'wrap-program
+               (lambda* (#:key outputs #:allow-other-keys)
+                 (let* ((out (assoc-ref outputs "out"))
+                        (bin-dir (string-append out "/bin/"))
+                        (site-dir (string-append out "/lib/perl5/site_perl/"))
+                        (lib-path (getenv "PERL5LIB")))
+                   (for-each (cut wrap-program <>
+                                  `("PERL5LIB" ":" prefix
+                                    (,lib-path ,site-dir)))
+                             (find-files bin-dir)))))))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
+    (single-lint-warning-message (check-wrapper-inputs pkg))))
+
+(test-equal "bogus phase specifications don't crash the linter"
+  "invalid phase clause"
+  (let* ((phases
+          `(modify-phases %standard-phases
+             (add-invalid)))
+         (pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
+    (single-lint-warning-message (check-wrapper-inputs pkg))))
+
 (test-equal "file patches: different file name -> warning"
   "file names of patches should start with the package name"
   (single-lint-warning-message
@@ -758,6 +854,80 @@
                                (sha256 %null-sha256))))))
     (check-source-unstable-tarball pkg)))
 
+(define (package-with-phase-changes changes)
+  (dummy-package "x"
+                 (arguments `(#:phases
+                              ,(if (gexp? changes)
+                                   #~(modify-phases %standard-phases
+                                       #$@changes)
+                                   `(modify-phases %standard-phases
+                                      ,@changes))))))
+
+(test-equal "optional-tests: no check phase"
+  '()
+  (let ((pkg (package-with-phase-changes '())))
+    (check-optional-tests pkg)))
+
+(test-equal "optional-tests: check phase respects #:tests?"
+  '()
+  (let ((pkg (package-with-phase-changes
+              '((replace 'check
+                  (lambda* (#:key tests? #:allow-other-keys?)
+                    (when tests?
+                      (invoke "./the-test-suite"))))))))
+    (check-optional-tests pkg)))
+
+(test-equal "optional-tests: check phase ignores #:tests?"
+  "the 'check' phase should respect #:tests?"
+  (let ((pkg (package-with-phase-changes
+              '((replace 'check
+                  (lambda _
+                    (invoke "./the-test-suite")))))))
+    (single-lint-warning-message
+     (check-optional-tests pkg))))
+
+(test-equal "optional-tests: do not crash when #:phases is invalid"
+  "incorrect call to ‘modify-phases’"
+  (let ((pkg (package-with-phase-changes 'this-is-not-a-list)))
+    (single-lint-warning-message
+     (check-optional-tests pkg))))
+
+(test-equal "optional-tests: allow G-exps (no warning)"
+  '()
+  (let ((pkg (package-with-phase-changes #~())))
+    (check-optional-tests pkg)))
+
+(test-equal "optional-tests: allow G-exps (warning)"
+  "the 'check' phase should respect #:tests?"
+  (let ((pkg (package-with-phase-changes
+              #~((replace 'check
+                   (lambda _
+                     (invoke "/the-test-suite")))))))
+    (single-lint-warning-message
+     (check-optional-tests pkg))))
+
+(test-equal "optional-tests: complicated 'check' phase"
+  "the 'check' phase should respect #:tests?"
+  (let ((pkg (package-with-phase-changes
+              '((replace 'check
+                  (lambda* (#:key inputs tests? #:allow-other-keys)
+                    (let ((something (stuff from inputs or native-inputs)))
+                      (delete-file "dateutil/test/test_utils.py")
+                      (invoke "pytest" "-vv"))))))))
+    (single-lint-warning-message
+     (check-optional-tests pkg))))
+
+(test-equal "optional-tests: 'check' phase is not first phase"
+  "the 'check' phase should respect #:tests?"
+  (let ((pkg (package-with-phase-changes
+              '((add-after 'unpack
+                    (lambda _
+                      (chdir "libtestcase-0.0.0")))
+                (replace 'check
+                  (lambda _ (invoke "./test-suite")))))))
+    (single-lint-warning-message
+     (check-optional-tests pkg))))
+
 (test-equal "source: 200"
   '()
   (with-http-server `((200 ,%long-string))
diff --git a/tests/pack.scm b/tests/pack.scm
index 8564939ee1..98bfedf21c 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +33,7 @@
   #:use-module ((gnu packages base) #:select (glibc-utf8-locales))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages compression) #:select (squashfs-tools))
+  #:use-module ((gnu packages debian) #:select (dpkg))
   #:use-module ((gnu packages guile) #:select (guile-sqlite3))
   #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
   #:use-module (srfi srfi-64))
@@ -51,11 +53,13 @@
 (define %gzip-compressor
   ;; Compressor that uses the bootstrap 'gzip'.
   ((@ (guix scripts pack) compressor) "gzip"
-   "gz"
+   ".gz"
    #~(list #+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n")))
 
 (define %tar-bootstrap %bootstrap-coreutils&co)
 
+(define %ar-bootstrap %bootstrap-binutils)
+
 
 (test-begin "pack")
 
@@ -270,6 +274,94 @@
                                                  1)
                                                 (pk 'guilelink (readlink "bin"))))
                              (mkdir #$output))))))))
+      (built-derivations (list check))))
+
+  (unless store (test-skip 1))
+  (test-assertm "deb archive with symlinks and control files" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile (profile-derivation (packages->manifest
+                                       (list %bootstrap-guile))
+                                      #:hooks '()
+                                      #:locales? #f))
+         (deb (debian-archive
+               "deb-pack" profile
+               #:compressor %gzip-compressor
+               #:symlinks '(("/opt/gnu/bin" -> "bin"))
+               #:archiver %tar-bootstrap
+               #:extra-options
+               (list #:triggers-file
+                     (plain-file "triggers"
+                                 "activate-noawait /usr/share/icons/hicolor\n")
+                     #:postinst-file
+                     (plain-file "postinst"
+                                 "echo running configure script\n"))))
+         (check
+          (gexp->derivation "check-deb-pack"
+            (with-imported-modules '((guix build utils))
+              #~(begin
+                  (use-modules (guix build utils)
+                               (ice-9 match)
+                               (ice-9 popen)
+                               (ice-9 rdelim)
+                               (ice-9 textual-ports)
+                               (rnrs base))
+
+                  (setenv "PATH" (string-join
+                                  (list (string-append #+%tar-bootstrap "/bin")
+                                        (string-append #+dpkg "/bin")
+                                        (string-append #+%ar-bootstrap "/bin"))
+                                  ":"))
+
+                  ;; Validate the output of 'dpkg --info'.
+                  (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb))
+                         (info (get-string-all port))
+                         (exit-val (status:exit-val (close-pipe port))))
+                    (assert (zero? exit-val))
+
+                    (assert (string-contains
+                             info
+                             (string-append "Package: "
+                                            #+(package-name %bootstrap-guile))))
+
+                    (assert (string-contains
+                             info
+                             (string-append "Version: "
+                                            #+(package-version %bootstrap-guile)))))
+
+                  ;; Sanity check .deb contents.
+                  (invoke "ar" "-xv" #$deb)
+                  (assert (file-exists? "debian-binary"))
+                  (assert (file-exists? "data.tar.gz"))
+                  (assert (file-exists? "control.tar.gz"))
+
+                  ;; Verify there are no hard links in data.tar.gz, as hard
+                  ;; links would cause dpkg to fail unpacking the archive.
+                  (define hard-links
+                    (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz")))
+                      (let loop ((hard-links '()))
+                        (match (read-line port)
+                          ((? eof-object?)
+                           (assert (zero? (status:exit-val (close-pipe port))))
+                           hard-links)
+                          (line
+                           (if (string-prefix? "u" line)
+                               (loop (cons line hard-links))
+                               (loop hard-links)))))))
+
+                  (unless (null? hard-links)
+                    (error "hard links found in data.tar.gz" hard-links))
+
+                  ;; Verify the presence of the control files.
+                  (invoke "tar" "-xf" "control.tar.gz")
+                  (assert (file-exists? "control"))
+                  (assert (and (file-exists? "postinst")
+                               (= #o111 ;script is executable
+                                  (logand #o111 (stat:perms
+                                                 (stat "postinst"))))))
+                  (assert (file-exists? "triggers"))
+
+                  (mkdir #$output))))))
       (built-derivations (list check)))))
 
 (test-end)
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 85badd2da6..86a36a388d 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -82,6 +83,17 @@
         (let ((config (serializable-configuration)))
           (serialize-configuration config serializable-configuration-fields)))))
 
+(define (custom-prefix-serialize-integer field-name name) name)
+
+(define-configuration configuration-with-prefix
+  (port (integer 10) "The port number.")
+  (prefix custom-prefix-))
+
+(test-assert "serialize-configuration with prefix"
+  (gexp?
+   (let ((config (configuration-with-prefix)))
+     (serialize-configuration config configuration-with-prefix-fields))))
+
 
 ;;;
 ;;; define-maybe macro.