From 3a09e1d2e8ef976e5d5e35d47fcb92ae501a651e Mon Sep 17 00:00:00 2001 From: Cyrill Schenkel Date: Sun, 27 Jul 2014 00:53:16 +0200 Subject: ui: Fix handling of periods by fill-paragraph. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * guix/ui.scm (fill-paragraph): Two spaces after period and no spaces before newline. * tests/ui.scm: New test case. Signed-off-by: Ludovic Courtès --- tests/ui.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'tests') diff --git a/tests/ui.scm b/tests/ui.scm index 4bf7a779c5..7cc02649e1 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -67,6 +67,11 @@ interface, and powerful string processing.") 10) #\newline)) +(test-equal "fill-paragraph, two spaces after period" + "First line. Second line" + (fill-paragraph "First line. +Second line" 24)) + (test-equal "package-specification->name+version+output" '(("guile" #f "out") ("guile" "2.0.9" "out") -- cgit v1.2.3 From f755403014e70d875541bcce5474d2cf410b5da1 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Tue, 12 Aug 2014 12:32:16 +0400 Subject: profiles: Add 'manifest-add'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/profiles.scm (manifest-add): New procedure. * tests/profiles.scm (guile-1.8.8): New variable. ("manifest-add"): New test. Signed-off-by: Ludovic Courtès --- tests/profiles.scm | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) (limited to 'tests') diff --git a/tests/profiles.scm b/tests/profiles.scm index d405f6453e..b2919d7315 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -40,6 +40,13 @@ ;; Example manifest entries. +(define guile-1.8.8 + (manifest-entry + (name "guile") + (version "1.8.8") + (item "/gnu/store/...") + (output "out"))) + (define guile-2.0.9 (manifest-entry (name "guile") @@ -101,6 +108,20 @@ (null? (manifest-entries m3)) (null? (manifest-entries m4))))))) +(test-assert "manifest-add" + (let* ((m0 (manifest '())) + (m1 (manifest-add m0 (list guile-1.8.8))) + (m2 (manifest-add m1 (list guile-2.0.9))) + (m3 (manifest-add m2 (list guile-2.0.9:debug))) + (m4 (manifest-add m3 (list guile-2.0.9:debug)))) + (and (match (manifest-entries m1) + ((($ "guile" "1.8.8" "out")) #t) + (_ #f)) + (match (manifest-entries m2) + ((($ "guile" "2.0.9" "out")) #t) + (_ #f)) + (equal? m3 m4)))) + (test-assert "profile-derivation" (run-with-store %store (mlet* %store-monad -- cgit v1.2.3 From 4231f05bbc29e4e3deffc9106a5faf14920979d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 17 Aug 2014 20:56:47 +0200 Subject: monads: Add 'package->cross-derivation' and #:target for 'package-file'. * guix/monads.scm (package-file): Add #:target keyword parameter and honor it. (package->cross-derivation): New procedure. * tests/monads.scm ("package-file + package->cross-derivation"): New test. * doc/guix.texi (The Store Monad): Update 'package-file' documentation. Add 'package->cross-derivation'. --- tests/monads.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'tests') diff --git a/tests/monads.scm b/tests/monads.scm index ea3e4006ab..78a014ea6a 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -24,6 +24,7 @@ #:select (package-derivation %current-system)) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) + #:use-module ((gnu packages base) #:select (coreutils)) #:use-module (ice-9 match) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) @@ -108,6 +109,16 @@ guile))) #:guile-for-build (package-derivation %store %bootstrap-guile))) +(test-assert "package-file + package->cross-derivation" + (run-with-store %store + (mlet* %store-monad ((file (package-file coreutils "bin/ls" + #:target "foo64-gnu")) + (xcu (package->cross-derivation coreutils + "foo64-gnu"))) + (let ((output (derivation->output-path xcu))) + (return (string=? file (string-append output "/bin/ls"))))) + #:guile-for-build (package-derivation %store %bootstrap-guile))) + (test-assert "interned-file" (run-with-store %store (mlet* %store-monad ((file -> (search-path %load-path "guix.scm")) -- cgit v1.2.3 From c90ddc8f811496e9da9ea1e6832a662bf767d6d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 17 Aug 2014 21:08:06 +0200 Subject: monads: 'package-file' uses '%current-system' at '>>=' time. * guix/monads.scm (package-file): Leave #:system to #f by default. * tests/monads.scm ("package-file, default system"): New test. --- tests/monads.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'tests') diff --git a/tests/monads.scm b/tests/monads.scm index 78a014ea6a..b814b0f7c5 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -109,6 +109,20 @@ guile))) #:guile-for-build (package-derivation %store %bootstrap-guile))) +(test-assert "package-file, default system" + ;; The default system should be the one at '>>=' time, not the one at + ;; invocation time. See . + (run-with-store %store + (mlet* %store-monad + ((system -> (%current-system)) + (file (parameterize ((%current-system "foobar64-linux")) + (package-file coreutils "bin/ls"))) + (cu (package->derivation coreutils))) + (return (string=? file + (string-append (derivation->output-path cu) + "/bin/ls")))) + #:guile-for-build (package-derivation %store %bootstrap-guile))) + (test-assert "package-file + package->cross-derivation" (run-with-store %store (mlet* %store-monad ((file (package-file coreutils "bin/ls" -- cgit v1.2.3 From 68a61e9ffb4d1c8b54db68d61a3669bda50f1bd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 17 Aug 2014 21:20:11 +0200 Subject: gexp: Add #:target parameter to 'gexp->derivation'. * guix/gexp.scm (lower-inputs): Add #:system and #:target. Use 'package->cross-derivation' when TARGET is true. Honor SYSTEM. (gexp->derivation): Add #:target argument. Pass SYSTEM and TARGET to 'lower-inputs' and 'gexp->sexp'. (gexp->sexp): Add #:system and #:target. Pass them in recursive call and to 'package-file'. * tests/gexp.scm (gexp->sexp*): Add 'system' and 'target' parameters. ("gexp->derivation, cross-compilation"): New test. --- tests/gexp.scm | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/gexp.scm b/tests/gexp.scm index bdea4b8563..9cc7d41547 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -47,8 +47,11 @@ ;; Make it the default. (%guile-for-build guile-for-build) -(define (gexp->sexp* exp) - (run-with-store %store (gexp->sexp exp) +(define* (gexp->sexp* exp #:optional + (system (%current-system)) target) + (run-with-store %store (gexp->sexp exp + #:system system + #:target target) #:guile-for-build guile-for-build)) (define-syntax-rule (test-assertm name exp) @@ -223,6 +226,20 @@ (mlet %store-monad ((drv mdrv)) (return (string=? system (derivation-system drv)))))) +(test-assertm "gexp->derivation, cross-compilation" + (mlet* %store-monad ((target -> "mips64el-linux") + (exp -> (gexp (list (ungexp coreutils) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp + #:target target)) + (refs ((store-lift references) + (derivation-file-name xdrv))) + (xcu (package->cross-derivation coreutils + target)) + (cu (package->derivation coreutils))) + (return (and (member (derivation-file-name xcu) refs) + (not (member (derivation-file-name cu) refs)))))) + (define shebang (string-append "#!" (derivation->output-path guile-for-build) "/bin/guile --no-auto-compile")) -- cgit v1.2.3 From 667b2508464374a01db3588504b981ec9266a2ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 18 Aug 2014 14:53:10 +0200 Subject: gexp: Add 'ungexp-native' and 'ungexp-native-splicing'. * guix/gexp.scm ()[natives]: New field. (write-gexp): Use both 'gexp-references' and 'gexp-native-references'. (gexp->derivation): Use both 'gexp-inputs' and 'gexp-native-inputs', and append them. (gexp-inputs): Add 'references' parameter and honor it. (gexp-native-inputs): New procedure. (gexp->sexp)[reference->sexp]: Add 'native?' parameter and honor it. Use it, and use 'gexp-native-references'. (gexp)[collect-native-escapes]: New procedure. [escape->ref]: Handle 'ungexp-native' and 'ungexp-native-splicing'. [substitute-ungexp, substitute-ungexp-splicing]: New procedures. [substitute-references]: Use them, and handle 'ungexp-native' and 'ungexp-native-splicing'. Adjust generated 'make-gexp' call to provide both normal references and native references. [read-ungexp]: Support 'ungexp-native' and 'ungexp-native-splicing'. Add reader extension for #+. * tests/gexp.scm (gexp-native-inputs): New procedure. (gexp->sexp*): Add 'target' parameter. ("ungexp + ungexp-native", "input list + ungexp-native", "input list splicing + ungexp-native-splicing", "gexp->derivation, ungexp-native", "gexp->derivation, ungexp + ungexp-native"): New tests. ("sugar"): Add tests for #+ and #+@. * doc/guix.texi (G-Expressions): Document 'ungexp-native' et al. --- tests/gexp.scm | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 98 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/tests/gexp.scm b/tests/gexp.scm index 9cc7d41547..694bd409bc 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -39,6 +39,7 @@ ;; For white-box testing. (define gexp-inputs (@@ (guix gexp) gexp-inputs)) +(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs)) (define gexp->sexp (@@ (guix gexp) gexp->sexp)) (define guile-for-build @@ -47,10 +48,8 @@ ;; Make it the default. (%guile-for-build guile-for-build) -(define* (gexp->sexp* exp #:optional - (system (%current-system)) target) +(define* (gexp->sexp* exp #:optional target) (run-with-store %store (gexp->sexp exp - #:system system #:target target) #:guile-for-build guile-for-build)) @@ -137,6 +136,29 @@ (e3 `(display ,txt))) (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp)))))) +(test-assert "ungexp + ungexp-native" + (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) + (ungexp coreutils) + (ungexp-native glibc) + (ungexp binutils)))) + (target "mips64el-linux") + (guile (derivation->output-path + (package-derivation %store %bootstrap-guile))) + (cu (derivation->output-path + (package-cross-derivation %store coreutils target))) + (libc (derivation->output-path + (package-derivation %store glibc))) + (bu (derivation->output-path + (package-cross-derivation %store binutils target)))) + (and (lset= equal? + `((,%bootstrap-guile "out") (,glibc "out")) + (gexp-native-inputs exp)) + (lset= equal? + `((,coreutils "out") (,binutils "out")) + (gexp-inputs exp)) + (equal? `(list ,guile ,cu ,libc ,bu) + (gexp->sexp* exp target))))) + (test-assert "input list" (let ((exp (gexp (display '(ungexp (list %bootstrap-guile coreutils))))) @@ -150,6 +172,28 @@ (equal? `(display '(,guile ,cu)) (gexp->sexp* exp))))) +(test-assert "input list + ungexp-native" + (let* ((target "mips64el-linux") + (exp (gexp (display + (cons '(ungexp-native (list %bootstrap-guile coreutils)) + '(ungexp (list glibc binutils)))))) + (guile (derivation->output-path + (package-derivation %store %bootstrap-guile))) + (cu (derivation->output-path + (package-derivation %store coreutils))) + (xlibc (derivation->output-path + (package-cross-derivation %store glibc target))) + (xbu (derivation->output-path + (package-cross-derivation %store binutils target)))) + (and (lset= equal? + `((,%bootstrap-guile "out") (,coreutils "out")) + (gexp-native-inputs exp)) + (lset= equal? + `((,glibc "out") (,binutils "out")) + (gexp-inputs exp)) + (equal? `(display (cons '(,guile ,cu) '(,xlibc ,xbu))) + (gexp->sexp* exp target))))) + (test-assert "input list splicing" (let* ((inputs (list (list glibc "debug") %bootstrap-guile)) (outputs (list (derivation->output-path @@ -164,6 +208,16 @@ (equal? (gexp->sexp* exp) `(list ,@(cons 5 outputs)))))) +(test-assert "input list splicing + ungexp-native-splicing" + (let* ((inputs (list (list glibc "debug") %bootstrap-guile)) + (exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs)))))) + (and (lset= equal? + `((,glibc "debug") (,%bootstrap-guile "out")) + (gexp-native-inputs exp)) + (null? (gexp-inputs exp)) + (equal? (gexp->sexp* exp) ;native + (gexp->sexp* exp "mips64el-linux"))))) + (test-assertm "gexp->file" (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (guile (package-file %bootstrap-guile)) @@ -240,6 +294,41 @@ (return (and (member (derivation-file-name xcu) refs) (not (member (derivation-file-name cu) refs)))))) +(test-assertm "gexp->derivation, ungexp-native" + (mlet* %store-monad ((target -> "mips64el-linux") + (exp -> (gexp (list (ungexp-native coreutils) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp + #:target target)) + (drv (gexp->derivation "foo" exp))) + (return (string=? (derivation-file-name drv) + (derivation-file-name xdrv))))) + +(test-assertm "gexp->derivation, ungexp + ungexp-native" + (mlet* %store-monad ((target -> "mips64el-linux") + (exp -> (gexp (list (ungexp-native coreutils) + (ungexp glibc) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp + #:target target)) + (refs ((store-lift references) + (derivation-file-name xdrv))) + (xglibc (package->cross-derivation glibc target)) + (cu (package->derivation coreutils))) + (return (and (member (derivation-file-name cu) refs) + (member (derivation-file-name xglibc) refs))))) + +(test-assertm "gexp->derivation, ungexp-native + composed gexps" + (mlet* %store-monad ((target -> "mips64el-linux") + (exp0 -> (gexp (list 1 2 + (ungexp coreutils)))) + (exp -> (gexp (list 0 (ungexp-native exp0)))) + (xdrv (gexp->derivation "foo" exp + #:target target)) + (drv (gexp->derivation "foo" exp))) + (return (string=? (derivation-file-name drv) + (derivation-file-name xdrv))))) + (define shebang (string-append "#!" (derivation->output-path guile-for-build) "/bin/guile --no-auto-compile")) @@ -285,8 +374,12 @@ (test-equal "sugar" '(gexp (foo (ungexp bar) (ungexp baz "out") (ungexp (chbouib 42)) - (ungexp-splicing (list x y z)))) - '#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z))) + (ungexp-splicing (list x y z)) + (ungexp-native foo) (ungexp-native foo "out") + (ungexp-native (chbouib 42)) + (ungexp-native-splicing (list x y z)))) + '#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z) + #+foo #+foo:out #+(chbouib 42) #+@(list x y z))) (test-end "gexp") -- cgit v1.2.3