From e380e8838d954863284b21f2bc9b65c165bd5bc1 Mon Sep 17 00:00:00 2001 From: Steffen Beyer Date: Wed, 1 Apr 2026 07:55:23 +0200 Subject: [PATCH] Add FreeBSD Guile verification harness --- docs/PROGRESS.md | 37 +++++ docs/reports/phase1-guile-freebsd.md | 110 +++++++++++++ tests/guile/modules/phase1/sample.scm | 25 +++ tests/guile/run-phase1-verification.sh | 30 ++++ tests/guile/verify-phase1.scm | 207 +++++++++++++++++++++++++ 5 files changed, 409 insertions(+) create mode 100644 docs/reports/phase1-guile-freebsd.md create mode 100644 tests/guile/modules/phase1/sample.scm create mode 100755 tests/guile/run-phase1-verification.sh create mode 100644 tests/guile/verify-phase1.scm diff --git a/docs/PROGRESS.md b/docs/PROGRESS.md index e69de29..3ad9313 100644 --- a/docs/PROGRESS.md +++ b/docs/PROGRESS.md @@ -0,0 +1,37 @@ +# Progress + +## 2026-04-01 — Phase 1.1 started: Guile verified on FreeBSD amd64 + +Completed work: + +- installed/confirmed `guile3-3.0.10` +- added a reusable verification harness: + - `tests/guile/run-phase1-verification.sh` + - `tests/guile/verify-phase1.scm` + - `tests/guile/modules/phase1/sample.scm` +- verified the following on `FreeBSD 15.0-STABLE` amd64: + - module loading + - deterministic output generation + - file I/O + - process handling with `primitive-fork`/`waitpid` + - loopback TCP sockets + - FFI calls into libc + - execution of Guix bootstrap-related code from `(guix build make-bootstrap)` +- wrote the results to `docs/reports/phase1-guile-freebsd.md` + +Notable findings: + +- `guile3` and `guile-3.0` are present, but there is no unversioned `guile` binary +- `system*` and `open-pipe*` currently segfault on this host (`exit 139`) +- despite that crash, the lower-level process primitives needed for further investigation do work + +Current assessment: + +- Phase 1.1 has a solid amd64 smoke-verification baseline +- Phase 1.1 is not fully complete yet because `i386` has not been checked and the subprocess crash needs investigation + +Next recommended step: + +1. investigate and isolate the `system*` / `open-pipe*` crash with a minimal reproducer +2. decide whether this requires a local Guile patch, a packaging fix, or Guix-side avoidance +3. once subprocess behavior is understood, continue with Phase 1.2 (minimal native build environment / GNU Hello) diff --git a/docs/reports/phase1-guile-freebsd.md b/docs/reports/phase1-guile-freebsd.md new file mode 100644 index 0000000..cd9d1c5 --- /dev/null +++ b/docs/reports/phase1-guile-freebsd.md @@ -0,0 +1,110 @@ +# Phase 1.1: Guile verification on FreeBSD amd64 + +Date: 2026-04-01 + +## Scope + +This step covers the first item in `docs/PLAN.md`: verify that GNU Guile is usable on FreeBSD as a foundation for the Guix port. + +The work in this step is limited to the current host (`FreeBSD 15.0-STABLE` on `amd64`). Cross-architecture verification for `i386` is still outstanding. + +## Environment + +- Host: `FreeBSD fruixdev 15.0-STABLE stable/15-n282801-29dce45d8c50 GENERIC amd64` +- FreeBSD version: `15.0-STABLE` +- Guile package: `guile3-3.0.10` +- Guile executables present: `/usr/local/bin/guile3`, `/usr/local/bin/guile-3.0` +- Guix source tree: `~/repos/guix` +- Guix source revision used for module loading: `62b61c20bcd20d3e8ec251a96e31f283d6a89374` + +## Artifacts added + +- `tests/guile/run-phase1-verification.sh` +- `tests/guile/verify-phase1.scm` +- `tests/guile/modules/phase1/sample.scm` + +## Verification command + +```sh +./tests/guile/run-phase1-verification.sh +``` + +## Result + +The verification suite passes on this FreeBSD amd64 host. + +Covered checks: + +1. Guile module loading for a local test module +2. Deterministic Scheme output (`alpha=1;beta=2;gamma=3;sum=14`) +3. File I/O +4. Process creation and reaping via `primitive-fork` + `waitpid` +5. Loopback TCP socket communication +6. FFI calls through `(system foreign)` using `getpid(2)` +7. Execution of Guix bootstrap-related code by importing `(guix build make-bootstrap)` and successfully running `copy-linux-headers` + +Expected deterministic payload hash: + +```text +7465da3704e9af1a71aaf4be99e62cff2631e410d7fe8b0bfbe3daf095de9b49 +``` + +Two consecutive runs produced the same deterministic payload. + +## Important findings + +### 1. Positive: core Guile functionality works + +The following are confirmed working on this machine: + +- Scheme evaluation +- module resolution +- file I/O +- process management with `primitive-fork` +- TCP sockets on loopback +- FFI into libc +- loading and executing Guix bootstrap module code + +This is enough to justify proceeding with the next Guix porting steps on FreeBSD. + +### 2. Negative: `system*` and `open-pipe*` currently crash + +These commands segfaulted on this host: + +```sh +guile3 -c '(system* "/usr/bin/true")' +guile3 -c '(use-modules (ice-9 popen)) (open-pipe* OPEN_READ "/usr/bin/true")' +``` + +Observed exit status: + +```text +exit:139 +``` + +This is a significant portability issue because Guix and related tooling commonly rely on subprocess helpers in this area. + +### 3. Packaging detail: no unversioned `guile` executable + +The FreeBSD package provides `guile3` and `guile-3.0`, but not an unversioned `guile` binary in `PATH`. Any automation should invoke `guile3` or detect one of the provided versioned names. + +## Assessment against plan item 1.1 + +### Achieved now + +- Verified Guile availability on FreeBSD amd64 +- Built a reusable verification suite for repeated testing +- Confirmed module loading, file I/O, processes, sockets, and FFI +- Confirmed execution of Guix bootstrap-related Scheme code from `make-bootstrap.scm` +- Confirmed deterministic output for a fixed Scheme workload + +### Still missing for full completion of 1.1 + +- Verification on `i386` +- Broader bootstrap coverage beyond `copy-linux-headers` +- Linux vs. FreeBSD output comparison from the same suite +- Root-cause analysis or workaround for `system*` / `open-pipe*` crashes + +## Recommended next step + +Before moving deeply into daemon and build-system work, investigate the FreeBSD Guile subprocess crash (`system*` / `open-pipe*`). If it is a Guile-on-FreeBSD issue rather than a local packaging issue, document a minimal reproducer and determine whether Guix can avoid those code paths or needs a local patch. diff --git a/tests/guile/modules/phase1/sample.scm b/tests/guile/modules/phase1/sample.scm new file mode 100644 index 0000000..6aaf702 --- /dev/null +++ b/tests/guile/modules/phase1/sample.scm @@ -0,0 +1,25 @@ +(define-module (phase1 sample) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-13) + #:export (sample-message deterministic-payload)) + +(define (sample-message) + "sample-module-ok") + +(define (deterministic-payload) + (let* ((pairs '((gamma . 3) (alpha . 1) (beta . 2))) + (sorted (sort pairs (lambda (a b) + (stringstring (car a)) + (symbol->string (car b)))))) + (sum (apply + (map (lambda (pair) + (* (cdr pair) (cdr pair))) + sorted)))) + (string-append + (string-join + (map (lambda (pair) + (string-append (symbol->string (car pair)) + "=" + (number->string (cdr pair)))) + sorted) + ";") + ";sum=" (number->string sum)))) diff --git a/tests/guile/run-phase1-verification.sh b/tests/guile/run-phase1-verification.sh new file mode 100755 index 0000000..2ff1e7f --- /dev/null +++ b/tests/guile/run-phase1-verification.sh @@ -0,0 +1,30 @@ +#!/bin/sh +set -eu + +script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd) +repo_root=$(CDPATH= cd -- "$script_dir/../.." && pwd) +guix_source_dir=${GUIX_SOURCE_DIR:-"$HOME/repos/guix"} + +if [ ! -d "$guix_source_dir/guix" ]; then + echo "Guix source tree not found at $guix_source_dir" >&2 + exit 1 +fi + +if command -v guile3 >/dev/null 2>&1; then + guile_bin=$(command -v guile3) +elif command -v guile-3.0 >/dev/null 2>&1; then + guile_bin=$(command -v guile-3.0) +else + echo "Unable to find guile3 or guile-3.0 in PATH" >&2 + exit 1 +fi + +export GUIX_SOURCE_DIR="$guix_source_dir" +export GUILE_AUTO_COMPILE=${GUILE_AUTO_COMPILE:-0} +if [ -n "${GUILE_LOAD_PATH:-}" ]; then + export GUILE_LOAD_PATH="$repo_root/tests/guile/modules:$guix_source_dir:$GUILE_LOAD_PATH" +else + export GUILE_LOAD_PATH="$repo_root/tests/guile/modules:$guix_source_dir" +fi + +exec "$guile_bin" -s "$repo_root/tests/guile/verify-phase1.scm" "$@" diff --git a/tests/guile/verify-phase1.scm b/tests/guile/verify-phase1.scm new file mode 100644 index 0000000..80d40aa --- /dev/null +++ b/tests/guile/verify-phase1.scm @@ -0,0 +1,207 @@ +(use-modules (ice-9 format) + (ice-9 rdelim) + (ice-9 textual-ports) + (ice-9 threads) + (system foreign) + (phase1 sample) + (guix build make-bootstrap)) + +(setvbuf (current-output-port) 'line) + +(define %bootstrap-linux-headers + '("atalk.h" + "errno.h" + "falloc.h" + "if_addr.h" + "if_ether.h" + "if_link.h" + "ioctl.h" + "kernel.h" + "limits.h" + "neighbour.h" + "netlink.h" + "param.h" + "prctl.h" + "posix_types.h" + "rtnetlink.h" + "socket.h" + "stddef.h" + "swab.h" + "sysctl.h" + "sysinfo.h" + "types.h" + "version.h")) + +(define %failures 0) + +(define (check name thunk) + (catch #t + (lambda () + (thunk) + (format #t "PASS ~a~%" name)) + (lambda (key . args) + (set! %failures (+ %failures 1)) + (format #t "FAIL ~a~%" name) + (format #t " key: ~s~%" key) + (format #t " args: ~s~%" args)))) + +(define (ensure condition message . args) + (unless condition + (apply error message args))) + +(define (read-file path) + (call-with-input-file path get-string-all)) + +(define (write-file path content) + (call-with-output-file path + (lambda (port) + (display content port)))) + +(define (make-tempdir prefix) + (mkdtemp (string-copy (string-append "/tmp/" prefix "-XXXXXX")))) + +(define (mkdir-p path) + (let loop ((parts (string-split path #\/)) + (current "")) + (when (pair? parts) + (let* ((part (car parts)) + (next (cond + ((string-null? part) + "/") + ((or (string=? current "") + (string=? current "/")) + (string-append current part)) + (else + (string-append current "/" part))))) + (unless (or (string-null? part) + (file-exists? next)) + (mkdir next)) + (loop (cdr parts) next))))) + +(define (touch path content) + (let ((slash (string-rindex path #\/))) + (when slash + (mkdir-p (substring path 0 slash))) + (write-file path content))) + +(define (test-module-system) + (ensure (string=? (sample-message) "sample-module-ok") + "unexpected module message: ~s" + (sample-message))) + +(define (test-deterministic-output) + (ensure (string=? (deterministic-payload) + "alpha=1;beta=2;gamma=3;sum=14") + "unexpected deterministic payload: ~s" + (deterministic-payload))) + +(define (test-file-io) + (let* ((dir (make-tempdir "fruix-guile-fileio")) + (path (string-append dir "/payload.txt")) + (payload "freebsd-guile-file-io-ok\nline-2\n")) + (write-file path payload) + (ensure (string=? (read-file path) payload) + "file payload mismatch for ~a" + path))) + +(define (test-processes) + (let* ((dir (make-tempdir "fruix-guile-process")) + (path (string-append dir "/child.txt"))) + (force-output (current-output-port)) + (let ((pid (primitive-fork))) + (if (zero? pid) + (begin + (write-file path "child-process-ok\n") + (primitive-exit 0)) + (let ((status (cdr (waitpid pid)))) + (ensure (= 0 (status:exit-val status)) + "child exited with status ~a" + (status:exit-val status)) + (ensure (string=? (read-file path) "child-process-ok\n") + "child file payload mismatch")))))) + +(define (test-sockets) + (let* ((server (socket AF_INET SOCK_STREAM 0))) + (setsockopt server SOL_SOCKET SO_REUSEADDR 1) + (bind server AF_INET INADDR_LOOPBACK 0) + (listen server 1) + (let* ((port (sockaddr:port (getsockname server))) + (thread (call-with-new-thread + (lambda () + (let* ((accepted (accept server)) + (conn (car accepted)) + (line (read-line conn))) + (display line conn) + (newline conn) + (force-output conn) + (close-port conn) + (close-port server)))))) + (let ((client (socket AF_INET SOCK_STREAM 0))) + (connect client AF_INET INADDR_LOOPBACK port) + (display "socket-roundtrip-ok" client) + (newline client) + (force-output client) + (ensure (string=? (read-line client) "socket-roundtrip-ok") + "socket roundtrip mismatch") + (close-port client) + (join-thread thread))))) + +(define (test-ffi) + (let* ((libc (dynamic-link)) + (ffi-getpid (pointer->procedure int + (dynamic-func "getpid" libc) + '()))) + (ensure (= (getpid) (ffi-getpid)) + "FFI getpid mismatch: Guile=~a FFI=~a" + (getpid) + (ffi-getpid)))) + +(define (test-guix-bootstrap) + (let* ((dir (make-tempdir "fruix-guix-bootstrap")) + (kernel-headers (string-append dir "/kernel-headers")) + (output (string-append dir "/output"))) + (mkdir-p (string-append kernel-headers "/include/linux/byteorder")) + (mkdir-p (string-append kernel-headers "/include/asm")) + (mkdir-p (string-append kernel-headers "/include/asm-generic")) + (for-each (lambda (header) + (touch (string-append kernel-headers "/include/linux/" header) + (string-append "/* " header " */\n"))) + %bootstrap-linux-headers) + (touch (string-append kernel-headers "/include/asm/signal.h") "/* asm */\n") + (touch (string-append kernel-headers "/include/asm-generic/errno-base.h") "/* asm-generic */\n") + (touch (string-append kernel-headers "/include/linux/byteorder/little_endian.h") + "/* byteorder */\n") + (let ((sink (open-output-string))) + (parameterize ((current-output-port sink) + (current-error-port sink)) + (ensure (copy-linux-headers output kernel-headers) + "copy-linux-headers returned false"))) + (ensure (file-exists? (string-append output "/include/linux/errno.h")) + "missing copied linux header") + (ensure (file-exists? (string-append output "/include/asm/signal.h")) + "missing copied asm header") + (ensure (file-exists? (string-append output "/include/linux/byteorder/little_endian.h")) + "missing copied byteorder header"))) + +(define (run-suite) + (format #t "Environment:~%") + (format #t " GUIX_SOURCE_DIR=~a~%" (or (getenv "GUIX_SOURCE_DIR") "")) + (format #t " GUILE_LOAD_PATH=~a~%" (or (getenv "GUILE_LOAD_PATH") "")) + (check "module-system" test-module-system) + (check "deterministic-output" test-deterministic-output) + (check "file-io" test-file-io) + (check "process-fork/wait" test-processes) + (check "loopback-socket" test-sockets) + (check "ffi-getpid" test-ffi) + (check "guix-build-make-bootstrap/copy-linux-headers" test-guix-bootstrap) + (format #t "Summary: ~a failure(s)~%" %failures) + (exit %failures)) + +(define (main args) + (if (member "--deterministic-payload" (cdr args)) + (begin + (display (deterministic-payload)) + (newline)) + (run-suite))) + +(main (command-line))