guix_mirror_bot pushed a commit to branch javascript-team in repository guix.
commit 3ed319ed4672d16b167c3ef730c72142f186d824 Author: Nicolas Graves <[email protected]> AuthorDate: Wed Mar 18 09:10:54 2026 +0100 tests: Add tests for (guix build json-utils). * tests/json-utils.scm: New file. * CODEOWNERS, etc/teams.scm, Makefile.am: Record tests/json-utils.scm. Change-Id: Iab107b04d3234c3b26186c56aed96d00050bb425 Signed-off-by: Jelle Licht <[email protected]> --- CODEOWNERS | 1 + Makefile.am | 1 + etc/teams.scm | 3 +- guix/build/json-utils.scm | 2 +- tests/json-utils.scm | 265 ++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 270 insertions(+), 2 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index 774f0c3b89..0c81de49ce 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -287,6 +287,7 @@ guix/build/json-utils\.scm @guix/javascript guix/build/node-build-system\.scm @guix/javascript guix/import/npm-binary\.scm @guix/javascript guix/scripts/import/npm-binary\.scm @guix/javascript +tests/json-utils\.scm @guix/javascript gnu/packages/julia(-.+|)\.scm$ @guix/julia guix/build/julia-build-system\.scm @guix/julia diff --git a/Makefile.am b/Makefile.am index e59d07d284..5bc82c2227 100644 --- a/Makefile.am +++ b/Makefile.am @@ -598,6 +598,7 @@ SCM_TESTS = \ tests/http-client.scm \ tests/inferior.scm \ tests/ipfs.scm \ + tests/json-utils.scm \ tests/ld-wrapper.scm \ tests/lint.scm \ tests/modules.scm \ diff --git a/etc/teams.scm b/etc/teams.scm index 5d34729dd4..0e53856739 100755 --- a/etc/teams.scm +++ b/etc/teams.scm @@ -884,7 +884,8 @@ and the maven-build-system." "guix/build/json-utils.scm" "guix/build/node-build-system.scm" "guix/import/npm-binary.scm" - "guix/scripts/import/npm-binary.scm"))) + "guix/scripts/import/npm-binary.scm" + "tests/json-utils.scm"))) (define-team julia (team 'julia diff --git a/guix/build/json-utils.scm b/guix/build/json-utils.scm index 67025a5b1a..9d94fd85c4 100644 --- a/guix/build/json-utils.scm +++ b/guix/build/json-utils.scm @@ -172,7 +172,7 @@ invalid field value provided, expected string or list of strings, got ~s~%") (data (if (and field-missing? insert?) (acons key '() data) data))) - (if field-missing? + (if (and field-missing? (not insert?)) (if strict? (raise (make-compound-condition (condition (&modify-json-missing-key-error diff --git a/tests/json-utils.scm b/tests/json-utils.scm new file mode 100644 index 0000000000..3f0ad0b8a0 --- /dev/null +++ b/tests/json-utils.scm @@ -0,0 +1,265 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2026 Nicolas Graves <[email protected]> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-json-utils) + #:use-module (guix build json-utils) + #:use-module (guix tests) + #:use-module (json) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64)) + +(define sample-json + '(("name" . "my-package") + ("version" . "1.0.0") + ("dependencies" . (("foo" . "^1.0.0") + ("bar" . "^2.0.0"))) + ("devDependencies" . (("baz" . "^3.0.0") + ("qux" . "^4.0.0"))) + ("scripts" . (("build" . "make build") + ("test" . "make test"))))) + +;; Many json-utils procedures use assoc-set! and assoc-remove! which +;; mutate alist structure in place. Use copy-tree to obtain a fresh +;; deep copy for each test. +(define (fresh-sample-json) + (copy-tree sample-json)) + +(define (package.json) + "Sample package.json file as a JSON string." + (call-with-output-string + (cute scm->json sample-json <> #:pretty #t))) + +(define (with-atomic-file-replacement/mock _ proc) + "Mock for with-atomic-file-replacement: reads from package.json procedure, +captures the written output as a string." + (call-with-input-string (package.json) + (lambda (in) + (call-with-output-string + (cute proc in <>))))) + +(define* (modify-json* #:rest all-arguments) + "Mock modify-json* with input from the package.json procedure." + (mock ((guix build utils) with-atomic-file-replacement + with-atomic-file-replacement/mock) + (json-string->scm (apply modify-json all-arguments)))) + +(test-begin "json-utils") + +;;; +;;; with-atomic-json-file-replacement +;;; + +(test-equal "with-atomic-json-file-replacement, modify top-level field" + "2.0.0" + (assoc-ref + (modify-json* (cut assoc-set! <> "version" "2.0.0")) + "version")) + +;;; +;;; delete-json-fields +;;; + +(test-assert "delete-json-fields, single top-level field" + (let ((result ((delete-json-fields '("version")) (fresh-sample-json)))) + (and (not (assoc-ref result "version")) + (assoc-ref result "name")))) + +(test-assert "delete-json-fields, multiple top-level fields" + (let ((result ((delete-json-fields '("version" "name")) (fresh-sample-json)))) + (and (not (assoc-ref result "version")) + (not (assoc-ref result "name")) + (assoc-ref result "dependencies")))) + +(test-assert "delete-json-fields, nested field with dot syntax" + (let ((result ((delete-json-fields '("dependencies.foo")) (fresh-sample-json)))) + (and (not (assoc-ref (assoc-ref result "dependencies") "foo")) + (assoc-ref (assoc-ref result "dependencies") "bar")))) + +(test-assert "delete-json-fields, nested field with list syntax" + (let ((result ((delete-json-fields '(("dependencies" "bar"))) + (fresh-sample-json)))) + (and (not (assoc-ref (assoc-ref result "dependencies") "bar")) + (assoc-ref (assoc-ref result "dependencies") "foo")))) + +(test-assert "delete-json-fields, missing field with strict? #f" + (let ((result ((delete-json-fields '("nonexistent") #:strict? #f) + (fresh-sample-json)))) + (assoc-ref result "name"))) + +(test-error "delete-json-fields, missing field with strict? #t raises error" + &modify-json-missing-key-error + ((delete-json-fields '("nonexistent") #:strict? #t) (fresh-sample-json))) + +(test-assert "delete-json-fields, missing nested field with strict? #f" + (let ((result ((delete-json-fields '("dependencies.nonexistent") + #:strict? #f) + (fresh-sample-json)))) + (assoc-ref (assoc-ref result "dependencies") "foo"))) + +;;; +;;; replace-json-fields +;;; + +(test-equal "replace-json-fields, single top-level field" + "new-name" + (assoc-ref + ((replace-json-fields '(("name" . "new-name"))) (fresh-sample-json)) + "name")) + +(test-equal "replace-json-fields, nested field with dot syntax" + "^5.0.0" + (assoc-ref + (assoc-ref + ((replace-json-fields '(("dependencies.foo" . "^5.0.0"))) + (fresh-sample-json)) + "dependencies") + "foo")) + +(test-equal "replace-json-fields, nested field with list syntax" + "^6.0.0" + (assoc-ref + (assoc-ref + ((replace-json-fields '((("dependencies" "bar") . "^6.0.0"))) + (fresh-sample-json)) + "dependencies") + "bar")) + +(test-equal "replace-json-fields, multiple replacements" + '("new-name" . "2.0.0") + (let ((result ((replace-json-fields + '(("name" . "new-name") + ("version" . "2.0.0"))) + (fresh-sample-json)))) + (cons (assoc-ref result "name") + (assoc-ref result "version")))) + +(test-error "replace-json-fields, missing field with strict? #t raises error" + &modify-json-missing-key-error + ((replace-json-fields '(("nonexistent" . "value")) #:strict? #t) + (fresh-sample-json))) + +(test-assert "replace-json-fields, missing field with strict? #f" + (let ((result ((replace-json-fields '(("nonexistent" . "value")) + #:strict? #f) + (fresh-sample-json)))) + (equal? (assoc-ref result "name") "my-package"))) + +;;; +;;; modify-json-fields +;;; + +(test-equal "modify-json-fields, custom modifier on top-level field" + "MY-PACKAGE" + (assoc-ref + ((modify-json-fields '("name") + (lambda (field data key) + (assoc-set! data key (string-upcase (assoc-ref data key))))) + (fresh-sample-json)) + "name")) + +(test-equal "modify-json-fields, custom modifier on nested field" + "^1.0.0-patched" + (assoc-ref + (assoc-ref + ((modify-json-fields '("dependencies.foo") + (lambda (field data key) + (assoc-set! data key + (string-append (assoc-ref data key) "-patched")))) + (fresh-sample-json)) + "dependencies") + "foo")) + +(test-assert "modify-json-fields, insert? creates missing field" + (let ((result ((modify-json-fields '("newField") + (lambda (field data key) + (assoc-set! data key "inserted")) + #:insert? #t) + (fresh-sample-json)))) + (equal? (assoc-ref result "newField") "inserted"))) + +(test-assert "modify-json-fields, insert? creates nested missing fields" + (let ((result ((modify-json-fields '("newSection.newKey") + (lambda (field data key) + (assoc-set! data key "deep-insert")) + #:insert? #t) + (fresh-sample-json)))) + (equal? (assoc-ref (assoc-ref result "newSection") "newKey") + "deep-insert"))) + +(test-assert "modify-json-fields, field-path-mapper" + (let ((result ((modify-json-fields '(("name" . "REPLACED")) + (lambda (field data key) + (assoc-set! data key (cdr field))) + #:field-path-mapper car) + (fresh-sample-json)))) + (equal? (assoc-ref result "name") "REPLACED"))) + +(test-error "modify-json-fields, invalid field-path raises error" + &modify-json-invalid-field-value-error + ((modify-json-fields '(42) (lambda (field data key) data)) + (fresh-sample-json))) + +;;; +;;; modify-json (deprecated wrapper) +;;; + +(test-equal "modify-json, single modification" + "modified" + (assoc-ref + (modify-json* (cut assoc-set! <> "name" "modified")) + "name")) + +(test-equal "modify-json, chained modifications" + '("chain-name" . "3.0.0") + (let ((result (modify-json* + (cut assoc-set! <> "name" "chain-name") + (cut assoc-set! <> "version" "3.0.0")))) + (cons (assoc-ref result "name") + (assoc-ref result "version")))) + +;;; +;;; Integration: delete-json-fields and replace-json-fields with modify-json +;;; + +(test-equal "modify-json + delete-json-fields integration" + #f + (assoc-ref + (modify-json* (delete-json-fields '("devDependencies"))) + "devDependencies")) + +(test-equal "modify-json + replace-json-fields integration" + "^9.0.0" + (assoc-ref + (assoc-ref + (modify-json* (replace-json-fields '(("dependencies.foo" . "^9.0.0")))) + "dependencies") + "foo")) + +(test-equal "modify-json + chained delete and replace integration" + '(#f . "replaced-name") + (let ((result (modify-json* + (delete-json-fields '("devDependencies")) + (replace-json-fields '(("name" . "replaced-name")))))) + (cons (assoc-ref result "devDependencies") + (assoc-ref result "name")))) + +(test-end "json-utils") + +;; Local Variables: +;; eval: (put 'modify-json-fields 'scheme-indent-function 1) +;; End:
