gnu: Add xfstests.

This is a follow-up to b485b1f548dce7d401d87472c49f396b0b5475f9 which
removed this package.

* gnu/packages/file-systems.scm (xfstests): New variable.

Change-Id: I2a536f31033f6dcec17feb0122bc243dfc3bc1f3
Signed-off-by: Vagrant Cascadian <vagrant@debian.org>

1 files changed, 146 insertions, 0 deletions

diff --git a/gnu/packages/file-systems.scm b/gnu/packages/file-systems.scm
index afe0c7ae02c..8c729fe5dfb 100644
--- a/gnu/packages/file-systems.scm
+++ b/gnu/packages/file-systems.scm
@@ -1501,6 +1501,152 @@ can create and compare snapshots, revert differences between them, and
 supports automatic snapshots timelines.")
     (license license:gpl2)))
 
+(define-public xfstests
+  (package
+    (name "xfstests")
+    (version "2026.03.20")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+              (url "git://git.kernel.org/pub/scm/fs/xfs/xfstests-dev.git")
+              (commit (string-append "v" version))))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "04x24izan3g2znnq6lzn3zlq0bl34qad530cp4ynm412w6q97kbz"))))
+    (build-system gnu-build-system)
+    (arguments
+     (list
+      #:make-flags
+      #~(list (string-append "INSTALL="
+                             (search-input-file %build-inputs "/bin/install")))
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'unpack 'patch-tool-locations
+            (lambda* (#:key inputs #:allow-other-keys)
+              (substitute* "common/config"
+                ;; Make absolute file names relative.
+                (("(MKFS_PROG=\").*(\")" _ pre post)
+                 (string-append pre "mkfs" post)))
+              (for-each (lambda (file)
+                          (substitute* file
+                            (("( -s|#.|[= ])(/bin/sh|/bin/bash)" _ pre match)
+                             (string-append pre
+                                            (search-input-file inputs match)))
+                            (("/bin/(rm|true)" match)
+                             (search-input-file inputs match))
+                            (("/usr(/bin/time)" _ match)
+                             (search-input-file inputs match))))
+                        (append (find-files "common" ".*")
+                                (find-files "tests" ".*")
+                                (find-files "tools" ".*")
+                                (find-files "src" "\\.(c|sh)$")))))
+          (add-before 'bootstrap 'fix-hardcoded-binaries
+            (lambda* (#:key make-flags #:allow-other-keys)
+              (substitute* "m4/package_utilies.m4"
+                ;; Fix the bogus hard-coded paths for every single binary.
+                (("(AC_PATH_PROG\\(.*, ).*(\\))" _ pre post)
+                 (string-append pre (getenv "PATH") post)))))
+          (add-after 'install 'wrap-xfstests/check
+            ;; Keep wrapping distinct from 'create-helper-script below: users
+            ;; must be able to invoke xfstests/check directly if they prefer.
+            (lambda* (#:key inputs #:allow-other-keys)
+              (wrap-program (string-append #$output "/xfstests/check")
+                ;; Prefix the user's PATH with the minimum required tools.
+                ;; The suite has many other optional dependencies and will
+                ;; automatically select tests based on the original PATH.
+                `("PATH" ":" prefix
+                  ,(map (lambda (file)
+                          (dirname (search-input-file inputs file)))
+                        (list "bin/setfacl"         ; acl
+                              "bin/attr"            ; attr
+                              "bin/bc"              ; bc
+                              "bin/df"              ; coreutils
+                              "bin/hostname"        ; inetutils
+                              "bin/perl"            ; perl
+                              "sbin/mkfs.xfs")))))) ; xfsprogs
+          (add-after 'install 'create-helper
+            ;; Upstream installs only a ‘check’ script that's not in $PATH and
+            ;; would try to write to the store without explaining how to change
+            ;; that.  Install a simple helper script to make it discoverable.
+            (lambda* (#:key inputs #:allow-other-keys)
+              (let* ((check  (string-append #$output "/xfstests/check"))
+                     (bin    (string-append #$output "/bin"))
+                     (helper (string-append bin "/xfstests-check")))
+                (mkdir-p bin)
+                (with-output-to-file helper
+                  (lambda _
+                    (format #t "#!~a --no-auto-compile\n!#\n"
+                            (search-input-file inputs "/bin/guile"))
+                    (write
+                     `(begin
+                        (define (try proc dir)
+                          "Try to PROC DIR.  Return DIR on success, else #f."
+                          (with-exception-handler (const #f)
+                                                  (lambda _ (proc dir) dir)
+                                                  #:unwind? #t))
+
+                        (define args
+                          (cdr (command-line)))
+
+                        (when (or (member "--help" args)
+                                  (member "-h" args))
+                          (format #t "Usage: ~a [OPTION]...
+This Guix helper sets up a new writable RESULT_BASE if it's unset, then executes
+xfstest's \"~a\" command (with any OPTIONs) as documented below.\n\n"
+                                  ,(basename helper)
+                                  ,(basename check)))
+
+                        (let* ((gotenv-base (getenv "RESULT_BASE"))
+                               (base (or gotenv-base
+                                         (let loop ((count 0))
+                                           (or (try mkdir
+                                                    (format #f "xfstests.~a"
+                                                            count))
+                                               (loop (+ 1 count))))))
+                               (result-base (if (string-prefix? "/" base)
+                                                base
+                                                (string-append (getcwd) "/"
+                                                               base))))
+                          (setenv "RESULT_BASE" result-base)
+                          ;; CHECK must run in its own directory or will fail.
+                          (chdir ,(dirname check))
+                          (let ((status
+                                 (status:exit-val (apply system* ,check args))))
+                            (unless gotenv-base
+                              (try rmdir result-base))
+                            status))))))
+                (chmod helper #o755)))))))
+    (native-inputs
+     (list autoconf-2.71 automake libtool pkg-config))
+    (inputs
+     (list acl
+           attr
+           bash-minimal
+           bc
+           guile-3.0                  ; for our xfstests-check helper script
+           inetutils
+           `(,util-linux "lib")
+           perl
+           time
+           xfsprogs))
+    (home-page "https://git.kernel.org/pub/scm/fs/xfs/xfstests-dev.git")
+    (synopsis "File system @acronym{QA, Quality Assurance} test suite")
+    (description
+     "The @acronym{FSQA, File System Quality Assurance} regression test suite,
+more commonly known as xfstests, comprises over 1,500 tests that exercise
+(@dfn{torture}) both the user- and kernel-space parts of many different file
+systems.
+
+As the package's name subtly implies, it was originally developed to test the
+XFS file system.  Today, xfstests is the primary test suite for all major file
+systems supported by the kernel Linux including XFS, ext4, and Btrfs, but also
+virtual and network file systems such as NFS, 9P, and the overlay file system.
+
+The packaged @command{check} script is not in @env{PATH} but can be invoked
+with the included @command{xfstests-check} helper.")
+    (license license:gpl2)))
+
 (define-public zfs
   (package
     (name "zfs")