gexp: Support 'ungexp' forms in improper lists.

* guix/gexp.scm (gexp)[collect-escapes, substitute-references]: Replace
the (exp0 exp ...) patterns with (exp0 . exp) to match improper lists.
Adjust clause bodies accordingly.
* tests/gexp.scm ("one input package, dotted list"): New test.
This commit is contained in:
Ludovic Courtès 2017-01-01 22:22:14 +01:00
parent 4a6e889feb
commit 5e2e4a51f9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 5 deletions

View File

@ -812,9 +812,9 @@ environment."
(cons exp result)) (cons exp result))
((ungexp-native-splicing _ ...) ((ungexp-native-splicing _ ...)
(cons exp result)) (cons exp result))
((exp0 exp ...) ((exp0 . exp)
(let ((result (loop #'exp0 result))) (let ((result (loop #'exp0 result)))
(fold loop result #'(exp ...)))) (loop #'exp result)))
(_ (_
result)))) result))))
@ -875,9 +875,9 @@ environment."
(substitute-ungexp-splicing exp substs)) (substitute-ungexp-splicing exp substs))
(((ungexp-native-splicing _ ...) rest ...) (((ungexp-native-splicing _ ...) rest ...)
(substitute-ungexp-splicing exp substs)) (substitute-ungexp-splicing exp substs))
((exp0 exp ...) ((exp0 . exp)
#`(cons #,(substitute-references #'exp0 substs) #`(cons #,(substitute-references #'exp0 substs)
#,(substitute-references #'(exp ...) substs))) #,(substitute-references #'exp substs)))
(x #''x))) (x #''x)))
(syntax-case s (ungexp output) (syntax-case s (ungexp output)

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -92,6 +92,16 @@
(package-derivation %store coreutils))) (package-derivation %store coreutils)))
(gexp->sexp* exp))))) (gexp->sexp* exp)))))
(test-assert "one input package, dotted list"
(let ((exp (gexp (coreutils . (ungexp coreutils)))))
(and (gexp? exp)
(match (gexp-inputs exp)
(((p "out"))
(eq? p coreutils)))
(equal? `(coreutils . ,(derivation->output-path
(package-derivation %store coreutils)))
(gexp->sexp* exp)))))
(test-assert "one input origin" (test-assert "one input origin"
(let ((exp (gexp (display (ungexp (package-source coreutils)))))) (let ((exp (gexp (display (ungexp (package-source coreutils))))))
(and (gexp? exp) (and (gexp? exp)