Improving tests

This commit is contained in:
retropikzel 2025-12-06 08:21:03 +02:00
parent a1c16ba5ca
commit 9e2c609b68
4 changed files with 18 additions and 8 deletions

View File

@ -6,6 +6,8 @@
(define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer)) (define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer))
(define-c-procedure c-system libc 'system 'int '(pointer)) (define-c-procedure c-system libc 'system 'int '(pointer))
(define previous-exit-code #f)
(define (shell cmd) (define (shell cmd)
(let* ((temp-prefix (string->c-utf8 "npcmd")) (let* ((temp-prefix (string->c-utf8 "npcmd"))
(temp-name (lambda () (temp-name (lambda ()
@ -19,7 +21,7 @@
input-path input-path
" & "))) " & ")))
(create-pipe input-path 0777) (create-pipe input-path 0777)
(c-system (string->c-utf8 shell-command)) (set! previous-exit-code (c-system (string->c-utf8 shell-command)))
(pipe-read-string 64000 (open-input-pipe input-path #t)))) (pipe-read-string 64000 (open-input-pipe input-path #t))))
(define (lines->list port result) (define (lines->list port result)
@ -33,3 +35,5 @@
(define (shell->sexp cmd) (define (shell->sexp cmd)
(read (open-input-string (shell cmd)))) (read (open-input-string (shell cmd))))
(define (shell-exit-code) previous-exit-code)

View File

@ -8,7 +8,8 @@
(retropikzel named-pipes)) (retropikzel named-pipes))
(export shell (export shell
shell->list shell->list
shell->sexp) shell->sexp
shell-exit-code)
(include "shell.scm")) (include "shell.scm"))

View File

@ -15,3 +15,7 @@ Run given cmd string and return output as list of lines.
Run given cmd string and return output as sexp using read. Run given cmd string and return output as sexp using read.
(**shell-exit-code**)
Returns exit code of previous command that was run.

View File

@ -7,13 +7,14 @@
(test-begin "shell") (test-begin "shell")
(write (shell "ls")) (test-equal "Linux\n" (shell "uname"))
(newline) (test-equal 0 (shell-exit-code))
(write (shell->list "ls")) (test-equal '("Linux") (shell->list "uname"))
(newline) (test-equal 0 (shell-exit-code))
(test-equal '(1 2 3) (shell->sexp "echo '(1 2 3)'"))
(test-equal 0 (shell-exit-code))
(write (shell->sexp "echo '(1 2 3)'"))
(newline)
(test-end "shell") (test-end "shell")