ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Fix wrap-script argument handling.

Browse source 
* guix/build/utils.scm (wrap-script):
Don't add (car cl) one too many times, cl its self contains it's car.
Split the aguments string with string-tokenize to avoid leaving an empty
string argument when there should be none. These two bugs seemed to
be partially cancelling each other out so that scripts still worked when
ran with no arguments.

* tests/build-utils.scm: Adjust wrap-script to above changes.
Add two tests to ensure the command line arguments appear identical to a
script and its wrapped version.

Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
This commit is contained in:
Brendan Tildesley 2021-04-29 20:33:08 +10:00 committed by Maxim Cournoyer
parent 41ec0573b8
commit 7f8a896c5f
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 55 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
guix/build/utils.scm
View file

@ -8,6 +8,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1462,10 +1463,9 @@ (define update-env
`(let ((cl (command-line)))
(apply execl ,interpreter
(car cl)
(cons (car cl)
(append
',(string-split args #\space)
cl))))))
(append
',(string-tokenize args char-set:graphic)
cl)))))
(template (string-append prog ".XXXXXX"))
(out (mkstemp! template))
(st (stat prog))

57
tests/build-utils.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
;;;
@ -167,9 +168,7 @@ (define-module (test build-utils)
"/some/path:/some/other/path"))))
'(let ((cl (command-line)))
(apply execl "/anything/cabbage-bash-1.2.3/bin/sh"
(car cl)
(cons (car cl)
(append '("") cl)))))
(car cl) (append (quote ()) cl))))
script-contents)
(call-with-temporary-directory
(lambda (directory)
@ -208,8 +207,7 @@ (define-module (test build-utils)
`(let ((cl (command-line)))
(apply execl "/anything/cabbage-bash-1.2.3/bin/python3"
(car cl)
(cons (car cl)
(append '("" "-and" "-args") cl)))))
(append '("-and" "-args") cl))))
script-contents)
(call-with-temporary-directory
(lambda (directory)
@ -243,6 +241,54 @@ (define-module (test build-utils)
"/some/other/path")))
#f)))))
(define (arg-test bash-args)
(call-with-temporary-directory
(lambda (directory)
(let ((script-file-name (string-append directory "/bash-test.sh")))
(call-with-output-file script-file-name
(lambda (port)
(display (string-append "\
#!" (which "bash") bash-args "
echo \"$#$0$*${A}\"")
port)))
(display "Unwrapped script contents:\n")
(call-with-input-file script-file-name
(lambda (port) (display (get-string-all port))))
(newline) (newline)
(chmod script-file-name #o777)
(setenv "A" "A")
(let* ((run-script (lambda _
(open-pipe*
OPEN_READ
script-file-name "1" "2" "3 3" "4")))
(pipe (run-script))
(unwrapped-output (get-string-all pipe)))
(close-pipe pipe)
(wrap-script script-file-name `("A" = ("A\nA")))
(display "Wrapped script contents:\n")
(call-with-input-file script-file-name
(lambda (port) (display (get-string-all port))))
(newline) (newline)
(let* ((pipe (run-script))
(wrapped-output (get-string-all pipe)))
(close-pipe pipe)
(display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n")
(display unwrapped-output) (newline)
(display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n")
(display wrapped-output) (newline)
(string=? (string-append unwrapped-output "A\n")
wrapped-output)))))))
(test-assert "wrap-script, argument handling"
(arg-test ""))
(test-assert "wrap-script, argument handling, bash --norc"
(arg-test " --norc"))
(test-equal "substitute*, text contains a NUL byte, UTF-8"
"c\0d"
(with-fluids ((%default-port-encoding "UTF-8")
@ -287,5 +333,4 @@ (define-module (test build-utils)
("guile/bin" . ,(dirname (which "guile"))))
"guile"))))
(test-end)