Files
fruix/tests/dev-tools-packages.scm

218 lines
9.2 KiB
Scheme

(use-modules (ice-9 hash-table)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-13)
(srfi srfi-64)
(guix build utils)
(fruix packages freebsd)
(fruix system freebsd)
(fruix system freebsd build)
(fruix system freebsd render)
(fruix system freebsd utils))
(define dev-tool-packages
(list freebsd-nodejs
freebsd-npm
freebsd-ripgrep
freebsd-tmux
freebsd-neovim))
(define os
(operating-system #:development-packages dev-tool-packages
#:build-packages dev-tool-packages))
(define generated-files
(operating-system-generated-files os
#:guile-store "/tmp/test-guile"
#:guile-extra-store "/tmp/test-guile-extra"
#:shepherd-store "/tmp/test-shepherd"
#:guile-newt-store "/tmp/test-guile-newt"))
(define development-script
(assoc-ref generated-files "usr/local/bin/fruix-development-environment"))
(define build-script
(assoc-ref generated-files "usr/local/bin/fruix-build-environment"))
(define (install-targets package)
(map (lambda (entry)
(match entry
((_ _ target) target)))
(freebsd-package-install-plan package)))
(define (package-present? package packages)
(member (freebsd-package-name package)
(map freebsd-package-name packages)))
(define (path-directory path)
(let ((index (string-index-right path #\/)))
(if index
(substring path 0 index)
".")))
(define (symlink-target-exists? path)
(let ((target (false-if-exception (readlink path))))
(and target
(file-exists? (string-append (path-directory path) "/" target)))))
(define (path-present? path)
(or (file-exists? path)
(false-if-exception (readlink path))))
(define (merge-node source destination)
(let ((kind (stat:type (lstat source))))
(case kind
((directory)
(mkdir-p destination)
(for-each (lambda (entry)
(merge-node (string-append source "/" entry)
(string-append destination "/" entry)))
(directory-entries source)))
((symlink)
(unless (path-present? destination)
(mkdir-p (path-directory destination))
(symlink (readlink source) destination)))
(else
(unless (file-exists? destination)
(copy-node source destination))))))
(define (merge-package-output source-root target-root)
(mkdir-p target-root)
(for-each (lambda (entry)
(unless (string-prefix? "." entry)
(merge-node (string-append source-root "/" entry)
(string-append target-root "/" entry))))
(directory-entries source-root)))
(define (with-directory directory thunk)
(let ((cwd (getcwd)))
(dynamic-wind
(lambda () (chdir directory))
thunk
(lambda () (chdir cwd)))))
(test-begin "dev-tools-packages")
(test-assert "development profile includes nodejs"
(package-present? freebsd-nodejs %freebsd-host-staged-development-profile-packages))
(test-assert "development profile includes npm"
(package-present? freebsd-npm %freebsd-host-staged-development-profile-packages))
(test-assert "development profile includes ripgrep"
(package-present? freebsd-ripgrep %freebsd-host-staged-development-profile-packages))
(test-assert "development profile includes tmux"
(package-present? freebsd-tmux %freebsd-host-staged-development-profile-packages))
(test-assert "development profile includes neovim"
(package-present? freebsd-neovim %freebsd-host-staged-development-profile-packages))
(test-assert "nodejs stages key paths"
(every (lambda (target)
(member target (install-targets freebsd-nodejs)))
'("bin/node" "include/node" "share/man/man1/node.1.gz")))
(test-assert "npm stages key paths"
(every (lambda (target)
(member target (install-targets freebsd-npm)))
'("bin/npm" "bin/npx" "bin/node-gyp" "etc/npmrc" "lib/node_modules/npm")))
(test-assert "ripgrep stages key paths"
(every (lambda (target)
(member target (install-targets freebsd-ripgrep)))
'("bin/rg" "share/man/man1/rg.1.gz")))
(test-assert "tmux stages key paths"
(every (lambda (target)
(member target (install-targets freebsd-tmux)))
'("bin/tmux" "share/examples/tmux/example_tmux.conf" "share/man/man1/tmux.1.gz")))
(test-assert "neovim stages key paths"
(every (lambda (target)
(member target (install-targets freebsd-neovim)))
'("bin/nvim" "share/nvim" "lib/nvim" "lib/lua/5.1/lpeg.so")))
(test-assert "development helper exports runtime library path"
(string-contains development-script "export LD_LIBRARY_PATH=\"$profile/lib:$profile/usr/lib"))
(test-assert "development helper exports node path"
(string-contains development-script "export NODE_PATH=\"$profile/lib/node_modules"))
(test-assert "development helper exports vimruntime"
(string-contains development-script "export VIMRUNTIME=\"$profile/share/nvim/runtime\""))
(test-assert "build helper exports runtime library path"
(string-contains build-script "export LD_LIBRARY_PATH=\"$profile/lib:$profile/usr/lib"))
(let* ((store-dir (mktemp-directory "/tmp/fruix-dev-tools-store.XXXXXX"))
(profile-dir (mktemp-directory "/tmp/fruix-dev-tools-profile.XXXXXX"))
(cache (make-hash-table))
(source-cache (make-hash-table))
(package-stores
(map (lambda (package)
(cons (freebsd-package-name package)
(materialize-freebsd-package package store-dir cache source-cache)))
dev-tool-packages))
(node-store (assoc-ref package-stores "freebsd-nodejs"))
(npm-store (assoc-ref package-stores "freebsd-npm"))
(ripgrep-store (assoc-ref package-stores "freebsd-ripgrep"))
(tmux-store (assoc-ref package-stores "freebsd-tmux"))
(neovim-store (assoc-ref package-stores "freebsd-neovim"))
(npm-workdir (mktemp-directory "/tmp/fruix-npm-local.XXXXXX"))
(home-dir (string-append npm-workdir "/home"))
(pkg-dir (string-append npm-workdir "/pkg-a")))
(for-each (lambda (store)
(merge-package-output (cdr store) profile-dir))
package-stores)
(test-assert "nodejs materialization copies libuv target"
(symlink-target-exists? (string-append node-store "/lib/libuv.so.1")))
(test-assert "ripgrep materialization copies pcre2 target"
(symlink-target-exists? (string-append ripgrep-store "/lib/libpcre2-8.so.0")))
(test-assert "tmux materialization copies libevent target"
(symlink-target-exists? (string-append tmux-store "/lib/libevent_core-2.1.so.7")))
(test-assert "neovim materialization copies libluv target"
(symlink-target-exists? (string-append neovim-store "/lib/libluv.so.1")))
(mkdir-p home-dir)
(mkdir-p pkg-dir)
(write-file (string-append pkg-dir "/package.json")
"{\"name\":\"pkg-a\",\"version\":\"1.0.0\",\"main\":\"index.js\"}\n")
(write-file (string-append pkg-dir "/index.js")
"module.exports = 42;\n")
(write-file (string-append npm-workdir "/package.json")
"{\"name\":\"rootproj\",\"version\":\"1.0.0\",\"dependencies\":{\"pkg-a\":\"file:./pkg-a\"}}\n")
(setenv "HOME" home-dir)
(setenv "PATH" (string-append profile-dir "/bin:/bin:/usr/bin"))
(setenv "LD_LIBRARY_PATH" (string-append profile-dir "/lib:" profile-dir "/usr/lib:/lib:/usr/lib"))
(setenv "NODE_PATH" (string-append profile-dir "/lib/node_modules"))
(setenv "VIMRUNTIME" (string-append profile-dir "/share/nvim/runtime"))
(setenv "LUA_CPATH" (string-append profile-dir "/lib/lua/5.1/?.so;;"))
(test-assert "materialized node runs"
(string-prefix? "v24.14.0"
(command-output (string-append profile-dir "/bin/node") "--version")))
(test-assert "materialized npm runs"
(string-prefix? "11.11.0"
(command-output (string-append profile-dir "/bin/npm") "--version")))
(test-assert "materialized ripgrep runs"
(string-prefix? "ripgrep 15.1.0"
(command-output (string-append profile-dir "/bin/rg") "--version")))
(test-assert "materialized tmux runs"
(string-prefix? "tmux 3.6a"
(command-output (string-append profile-dir "/bin/tmux") "-V")))
(test-assert "materialized neovim runs"
(string-prefix? "NVIM v0.12.0"
(command-output (string-append profile-dir "/bin/nvim") "--version")))
(with-directory
npm-workdir
(lambda ()
(run-command (string-append profile-dir "/bin/npm")
"install"
"--ignore-scripts"
"--no-audit"
"--no-fund")
(test-assert "npm local install works"
(file-exists? (string-append npm-workdir "/node_modules/pkg-a/package.json")))
(test-equal "npm exec can run node against the local dependency"
"42"
(command-output (string-append profile-dir "/bin/npm")
"exec"
"--"
"node"
"-e"
"process.stdout.write(String(require(\"pkg-a\")))")))))
(test-end "dev-tools-packages")