Validate Guix builder phases on FreeBSD

tests/native-build/gnu-hello-guix-phase-runner.scm

@@ -0,0 +1,143 @@
+(use-modules (guix base32)
+             (guix build gnu-build-system)
+             (guix build utils)
+             (ice-9 format)
+             (ice-9 match)
+             (ice-9 popen)
+             (srfi srfi-1)
+             (rnrs bytevectors)
+             (rnrs io ports))
+
+(define (getenv* name default)
+  (or (getenv name) default))
+
+(define (trim-trailing-newlines str)
+  (let loop ((len (string-length str)))
+    (if (and (> len 0)
+             (char=? (string-ref str (- len 1)) #\newline))
+        (loop (- len 1))
+        (substring str 0 len))))
+
+(define (command-output program . args)
+  (let* ((port   (apply open-pipe* OPEN_READ program args))
+         (output (get-string-all port))
+         (status (close-pipe port)))
+    (unless (zero? status)
+      (error (format #f "command failed: ~a ~s => ~a"
+                     program args status)))
+    (trim-trailing-newlines output)))
+
+(define (nix-base32->hex str)
+  (string-concatenate
+   (map (lambda (byte)
+          (format #f "~2,'0x" byte))
+        (bytevector->u8-list (nix-base32-string->bytevector str)))))
+
+(define (phase-subset names)
+  (filter (match-lambda
+            ((name . _)
+             (memq name names)))
+          %standard-phases))
+
+(define workdir
+  (or (getenv "WORKDIR")
+      (error "WORKDIR environment variable is required")))
+
+(define hello-version
+  (getenv* "HELLO_VERSION" "2.12.3"))
+(define expected-nix-base32
+  (getenv* "HELLO_NIX_BASE32" "183a6rxnhixiyykd7qis0y9g9cfqhpkk872a245y3zl28can0pqd"))
+(define source-url
+  (getenv* "HELLO_SOURCE_URL"
+           (string-append "https://ftp.gnu.org/gnu/hello/hello-"
+                          hello-version ".tar.gz")))
+(define guix-source-dir
+  (getenv* "GUIX_SOURCE_DIR"
+           (string-append (getenv "HOME") "/repos/guix")))
+(define output-dir
+  (string-append workdir "/0000000000000000-hello-" hello-version))
+(define source-tarball
+  (string-append workdir "/hello-" hello-version ".tar.gz"))
+(define source-dir
+  (string-append workdir "/hello-" hello-version))
+(define metadata-file
+  (string-append workdir "/gnu-hello-guix-phase-runner-metadata.txt"))
+(define expected-sha256-hex
+  (nix-base32->hex expected-nix-base32))
+(define selected-phase-names
+  '(set-SOURCE-DATE-EPOCH unpack configure build check install))
+(define selected-phases
+  (phase-subset selected-phase-names))
+
+(setenv "NIX_BUILD_TOP" workdir)
+(mkdir-p workdir)
+
+(format #t "Using workdir: ~a~%" workdir)
+(format #t "Using Guix source: ~a~%" guix-source-dir)
+(format #t "Fetching source: ~a~%" source-url)
+(invoke "fetch" "-o" source-tarball source-url)
+
+(let ((actual-sha256-hex (command-output "sha256" "-q" source-tarball)))
+  (unless (string=? actual-sha256-hex expected-sha256-hex)
+    (error (format #f "sha256 mismatch: expected ~a but got ~a"
+                   expected-sha256-hex actual-sha256-hex)))
+
+  (format #t "Verified SHA256: ~a~%" actual-sha256-hex)
+  (format #t "Running Guix builder phases: ~s~%" selected-phase-names)
+
+  (with-directory-excursion workdir
+    (gnu-build #:source source-tarball
+               #:outputs `(("out" . ,output-dir))
+               #:phases selected-phases
+               #:tests? #t))
+
+  (let* ((installed-binary (string-append output-dir "/bin/hello"))
+         (hello-output (command-output installed-binary))
+         (host-triplet (with-directory-excursion source-dir
+                         (command-output "sh" "build-aux/config.guess")))
+         (binary-file (command-output "file" installed-binary))
+         (runtime-deps (command-output "ldd" installed-binary))
+         (check-summary
+          (call-with-input-file (string-append source-dir "/test-suite.log")
+            get-string-all))
+         (guile-bin (or (getenv "GUILE_BIN") "<unset>"))
+         (uname-string (command-output "uname" "-a")))
+    (unless (string=? hello-output "Hello, world!")
+      (error (format #f "unexpected hello output: ~s" hello-output)))
+
+    (call-with-output-file metadata-file
+      (lambda (port)
+        (format port "hello_version=~a~%" hello-version)
+        (format port "source_url=~a~%" source-url)
+        (format port "expected_nix_base32=~a~%" expected-nix-base32)
+        (format port "expected_sha256_hex=~a~%" expected-sha256-hex)
+        (format port "actual_sha256_hex=~a~%" actual-sha256-hex)
+        (format port "guix_source_dir=~a~%" guix-source-dir)
+        (format port "guile_bin=~a~%" guile-bin)
+        (format port "workdir=~a~%" workdir)
+        (format port "source_tarball=~a~%" source-tarball)
+        (format port "source_dir=~a~%" source-dir)
+        (format port "output_dir=~a~%" output-dir)
+        (format port "installed_binary=~a~%" installed-binary)
+        (format port "hello_output=~a~%" hello-output)
+        (format port "host_triplet=~a~%" host-triplet)
+        (format port "selected_phases=~s~%" selected-phase-names)
+        (format port "binary_file=~a~%" binary-file)
+        (format port "uname=~a~%" uname-string)
+        (format port "check_summary_begin~%~a~%check_summary_end~%"
+                check-summary)
+        (format port "runtime_deps_begin~%~a~%runtime_deps_end~%"
+                runtime-deps)))
+
+    (when (getenv "METADATA_OUT")
+      (mkdir-p (dirname (getenv "METADATA_OUT")))
+      (copy-file metadata-file (getenv "METADATA_OUT")))
+
+    (format #t "PASS gnu-hello-guix-phase-runner~%")
+    (format #t "Hello output: ~a~%" hello-output)
+    (format #t "Installed binary: ~a~%" installed-binary)
+    (format #t "Metadata file: ~a~%" metadata-file)
+    (when (getenv "METADATA_OUT")
+      (format #t "Copied metadata to: ~a~%" (getenv "METADATA_OUT")))
+    (display "--- metadata ---\n")
+    (display (call-with-input-file metadata-file get-string-all))))