mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

* standalone/test-system-cmds: new test.

Browse source
This commit is contained in:
Rob Browning 2003-11-19 21:39:07 +00:00
parent f24809dc2b
commit b10b93de99
1 changed files with 42 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

42
test-suite/standalone/test-system-cmds Executable file
View file

@ -0,0 +1,42 @@
#!/bin/sh
exec guile -s "$0" "$@"
!#
(define (test-system-cmd)
(if (not (boolean? (system)))
(begin
(simple-format
#t
"test-system-cmds: (system) did not return a boolean\n")
(exit 1)))
(let ((rs (status:exit-val (system "guile -c '(exit 42)'"))))
(if (not (= 42 rs))
(begin
(simple-format
#t
"test-system-cmds: system exit status was ~S rather than 42\n"
rs)
(exit 1)))))
(define (test-system*-cmd)
(let ((rs (status:exit-val (system* "guile" "-c" "(exit 42)"))))
(if (not (= 42 rs))
(begin
(simple-format
#t
"test-system-cmds: system* exit status was ~S rather than 42\n"
rs)
(exit 1)))))
(if (defined? 'system)
(test-system-cmd))
(if (defined? 'system*)
(test-system*-cmd))
(exit 0)
;; Local Variables:
;; mode: scheme
;; End: