mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 21:40:34 +02:00
Code Activity

Allows modification of shell used by open-pipe

Browse source 
open-pipe executes a shell command in a subprocess. This commit adds
the ability to modify the shell used for executing commands.
The default "/bin/sh -c" can be inspected and modified by the
new procedure-with-setter 'pipe-shell-command-transformer'.

This useful in MinGW since its "sh" is not in "/bin".

* module/ice-9/popen.scm (%command-transformer): new procedure
  (pipe-shell-command-transformer): new procedure-with-setter
  (open-pipe): use new command transformer
* doc/ref/posix.texi (open-pipe): mention pipe-shell-command-transformer
  (pipe-shell-command-transformer): document new procedure
* test-suite/tests/popen.test ("pipe-shell-command-transformer"): new tests
  Also, modify open-pipe shell for MinGW
* NEWS: updated
* test-suite/tests/ports.test (mingw?): new variable
    Also, modify open-pipe shell for MinGW
This commit is contained in:
Michael Gran 2023-06-25 07:57:18 -07:00
parent 9d625278f7
commit 1174e1eb9d
5 changed files with 83 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

26
test-suite/tests/popen.test
View file

@ -1,6 +1,6 @@
;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*-
;;;;
;;;; Copyright 2003, 2006, 2010, 2011, 2013, 2014, 2020
;;;; Copyright 2003, 2006, 2010, 2011, 2013, 2014, 2020, 2025
;;;; 2021 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
@ -48,6 +48,30 @@
(if-supported
(use-modules (ice-9 popen))
;;
;; pipe-shell-command-transformer
;;
(with-test-prefix "pipe-shell-command-transformer"
(pass-if-equal "default shell is /bin/sh"
'("/bin/sh" "-c" "test")
((pipe-shell-command-transformer) "test"))
(pass-if-equal "can set to /bin/bash"
'("/bin/bash" "-c" "test")
(let ((transform-prev (pipe-shell-command-transformer)))
(set! (pipe-shell-command-transformer)
(lambda (cmd)
`("/bin/bash" "-c" ,cmd)))
(let ((cmd ((pipe-shell-command-transformer) "test")))
(set! (pipe-shell-command-transformer) transform-prev)
cmd))))
(when mingw?
;; On MinGW, sh is not necessarily in /bin.
(set! (pipe-shell-command-transformer)
(lambda (cmd)
`("sh" "-c" ,cmd))))
;;
;; open-input-pipe

8
test-suite/tests/ports.test
View file

@ -31,6 +31,14 @@
get-bytevector-n
get-bytevector-all
unget-bytevector)))
(define mingw?
(string-contains %host-type "-mingw32"))
(when mingw?
;; On MinGW, sh is not necessarily in /bin.
(set! (pipe-shell-command-transformer)
(lambda (cmd)
`("sh" "-c" ,cmd))))
(define (display-line . args)
(for-each display args)