From 1f3d7b45349d43e5cc02594083e0cd44ef730992 Mon Sep 17 00:00:00 2001 From: Andrew Tropin Date: Fri, 18 Jun 2021 07:15:36 +0300 Subject: gexp: 'mixed-text-file' UTF-8-encodes its output. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/gexp.scm (mixed-text-file)[build]: Call 'set-port-encoding!'. Signed-off-by: Ludovic Courtès --- guix/gexp.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index afb935761e..187f5c5e85 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1921,6 +1921,7 @@ This is the declarative counterpart of 'text-file*'." (define build (gexp (call-with-output-file (ungexp output "out") (lambda (port) + (set-port-encoding! port "UTF-8") (display (string-append (ungexp-splicing text)) port))))) (computed-file name build)) -- cgit v1.2.3 From d9e0ae07db5cb9f949c11f4ee77146a070c2618c Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Mon, 28 Jun 2021 19:24:44 +0200 Subject: guix: gexp: Define gexp->approximate-sexp. It will be used in the 'optional-tests' linter. * guix/gexp.scm (gexp->approximate-sexp): New procedure. * tests/gexp.scm ("no references", "unquoted gexp", "unquoted gexp (native)") ("spliced gexp", "unspliced gexp, approximated") ("unquoted gexp, approximated"): Test it. * doc/gexp.scm ("G-Expressions"): Document it. Signed-off-by: Mathieu Othacehe --- doc/guix.texi | 10 ++++++++++ guix/gexp.scm | 19 +++++++++++++++++++ tests/gexp.scm | 31 +++++++++++++++++++++++++++++++ 3 files changed, 60 insertions(+) (limited to 'guix/gexp.scm') diff --git a/doc/guix.texi b/doc/guix.texi index e0668b1f5f..e39e4eb7be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10046,6 +10046,16 @@ corresponding to @var{obj} for @var{system}, cross-compiling for has an associated gexp compiler, such as a @code{}. @end deffn +@deffn {Procedure} gexp->approximate-sexp @var{gexp} +Sometimes, it may be useful to convert a G-exp into a S-exp. For +example, some linters (@pxref{Invoking guix lint}) peek into the build +phases of a package to detect potential problems. This conversion can +be achieved with this procedure. However, some information can be lost +in the process. More specifically, lowerable objects will be silently +replaced with some arbitrary object -- currently the list +@code{(*approximate*)}, but this may change. +@end deffn + @node Invoking guix repl @section Invoking @command{guix repl} diff --git a/guix/gexp.scm b/guix/gexp.scm index 187f5c5e85..f3d278b3e6 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ with-imported-modules with-extensions let-system + gexp->approximate-sexp gexp-input gexp-input? @@ -157,6 +159,23 @@ "Return the source code location of GEXP." (and=> (%gexp-location gexp) source-properties->location)) +(define* (gexp->approximate-sexp gexp) + "Return the S-expression corresponding to GEXP, but do not lower anything. +As a result, the S-expression will be approximate if GEXP has references." + (define (gexp-like? thing) + (or (gexp? thing) (gexp-input? thing))) + (apply (gexp-proc gexp) + (map (lambda (reference) + (match reference + (($ thing output native) + (if (gexp-like? thing) + (gexp->approximate-sexp thing) + ;; Simply returning 'thing' won't work in some + ;; situations; see 'write-gexp' below. + '(*approximate*))) + (_ '(*approximate*)))) + (gexp-references gexp)))) + (define (write-gexp gexp port) "Write GEXP on PORT." (display "# +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,6 +90,36 @@ (test-begin "gexp") +(test-equal "no references" + '(display "hello gexp->approximate-sexp!") + (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!"))) + +(test-equal "unquoted gexp" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #$inside)))) + +(test-equal "unquoted gexp (native)" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #+inside)))) + +(test-equal "spliced gexp" + '(display '(fresh vegetables)) + (let ((inside #~(fresh vegetables))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unspliced gexp, approximated" + ;; (*approximate*) is really an implementation detail + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unquoted gexp, approximated" + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '#$inside)))) + (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) -- cgit v1.2.3