Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Tarn Burton
asdf
Commits
111b9742
Commit
111b9742
authored
12 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Import the run-program tests from xcvb-driver.
parent
bf7fb395
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
test/test-run-program.script
+214
-18
214 additions, 18 deletions
test/test-run-program.script
with
214 additions
and
18 deletions
test/test-run-program.script
+
214
−
18
View file @
111b9742
;;; -*- Lisp -*-
#+xcvb
;;; TODO: write tests for run-program instead -- and/or
;;; import those from the original xcvb-driver-test
(declaim (optimize (debug 3) (safety 3)))
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(unless (os-unix-p)
(leave-test "The rest of this test is only supposed to work on Unix"))
;;; test asdf run-shell-command function
(when (asdf::os-unix-p)
(setf asdf::*verbose-out* nil)
(assert-equal 1 (run-shell-command "false"))
(assert-equal 0 (run-shell-command "true"))
(unless (< 0 (asdf:run-shell-command "./bad-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
(unless (equal 0 (run-shell-command "./good-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
;; NB1: run-shell-command is deprecated. Use run-program instead.
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
;; If you want 2>&1 redirection, you know where to find it.
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line))
(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms))
(assert-equal (format nil "ok 1~%") (run-program '("echo" "ok 1") :output :string))
(setf *verbose-out* nil)
(assert-equal 1 (run-shell-command "false"))
(assert-equal 0 (run-shell-command "true"))
(unless (< 0 (run-shell-command "./bad-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
(unless (equal 0 (run-shell-command "./good-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
;; NB1: run-shell-command is deprecated. Use run-program instead.
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
;; If you want 2>&1 redirection, you know where to find it.
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line))
(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms))
(assert-equal (format nil "ok 1~%") (run-program '("echo" "ok 1") :output :string))
;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess)
;;#+lispworks (trace system:run-shell-command system:pid-exit-status)
;; Poor man's test suite, lacking stefil.
(defmacro deftest (name formals &body body)
`(defun ,name ,formals ,@body))
(defmacro is (x)
`(progn
(format! *error-output* "~&Checking whether ~S~%" ',x)
(assert ,x)))
(defmacro signals (condition sexp)
`(progn
(format! *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition)
(handler-case
,sexp
(,condition () t)
(t (c)
(error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition))
(:no-error ()
(error "Expression ~S fails to raise condition ~S" ',sexp ',condition)))))
#|
Testing run-program
|#
;; We add a newline to the end of a string and return it.
;; We do it in this specific manner so that under unix, windows and macos,
;; format will choose the correct type of newline delimiters
(defun nl (str)
(format nil "~A~%" str))
;; Convert the input format to a string stream, read it into a string,
;; and see if they match.
(defun slurp-stream-string/check (input-string &key (test #'string=))
(let ((input-string (format nil input-string)))
(with-open-stream (s (make-string-input-stream input-string))
(is (funcall test input-string (slurp-stream-string s))))))
;; Call with a bunch of strings to call the above function upon.
(defun slurp-stream-string/checks (&rest input-string-list)
(dolist (input-string input-string-list)
(funcall #'slurp-stream-string/check input-string)))
;; Check to see if the input-string ins converted correctly to the
;; output-form
(defun slurp-stream-lines/check (input-string output-form &key (test #'equal))
(let ((input-string (format nil input-string)))
(with-open-stream (s (make-string-input-stream input-string))
(is (funcall test output-form (slurp-stream-lines s))))))
;; Check to see if the individual input/output lists passed into this
;; function are correct.
(defun slurp-stream-lines/checks (&rest control-forms)
(dolist (form control-forms)
(destructuring-bind (input-string output-form) form
(funcall #'slurp-stream-lines/check input-string output-form))))
(deftest test/slurp-stream-string ()
;; Check to make sure the string is exactly what it is when read
;; back through a stream. This is a format specifier so we can
;; portably test newline processing.
(slurp-stream-string/checks
""
" "
"~%"
"~%~%"
"~%~%~%"
"one~%two~%three~%~%four"
"one two three four"
"one two~%three four")
;; Check some boundary cases on the types passed.
(signals error (slurp-stream-string nil))
(signals error (slurp-stream-string 42))
(signals error (slurp-stream-string "not valid"))
t)
(deftest test/slurp-stream-lines ()
(slurp-stream-lines/checks
;; input-string first, then expected output-form after its parsing
'("" nil)
'(" " (" "))
'("~%" (""))
'("~%~%" ("" ""))
'("~%~%~%" ("" "" ""))
'("foo" ("foo"))
'("~%foo" ("" "foo"))
'("~%foo~%" ("" "foo")) ; consumes last newline!
'("one~%two~%~%three" ("one" "two" "" "three"))
'("one~%two~%~%three~%" ("one" "two" "" "three"))
'("one two three four" ("one two three four"))
'("one two~%three four~%" ("one two" "three four")))
;; Check some boundary cases on the types passed.
;; NOTE: NIL is ok since it means read from stdin!
(signals error (slurp-stream-lines 42))
(signals error (slurp-stream-lines "not valid"))
t)
(defun common-test/run-program ()
;; Can we echo a simple string?
(is (equal '("abcde")
(run-program '("echo" "abcde") :output :lines)))
(is (equal (nl "fghij")
(run-program '("echo" "fghij") :output :string)))
;; Are spaces handled properly?
(is (equal '("Hello World")
(run-program '("echo" "Hello World") :output :lines)))
(is (equal (nl "Hello World")
(run-program '("echo" "Hello World") :output :string)))
(is (equal (nl "Hello World")
(run-program "echo Hello World" :output :string)))
;; Test that run-program fails properly with an
;; empty program string
#+(or clozure (and allegro os-unix) cmu (and lispworks os-unix) sbcl scl)
(signals error (run-program '("") :output :lines))
;; An empty string itself is ok since it is passed to the shell.
(is (equal "" (run-program "" :output :string)))
;; Test that run-program fails properly with a
;; nil program list
#+(or clozure (and allegro os-unix) cmu sbcl scl)
(signals error (run-program nil :output :lines))
;; Test that run-program fails properly when the
;; executable doesn't exist.
(signals error (run-program '("does-not-exist") :output :lines))
(signals error (run-program "does-not-exist" :output :lines))
(is (equal 0 (run-program "echo ok" :output nil)))
(is (equal 0 (run-program '("echo" "ok") :output nil)))
t)
(defun unix-only-test/run-program ()
(is (equal 0 (run-program "true")))
(signals subprocess-error (run-program "false"))
(is (equal 1 (run-program "false" :ignore-error-status t)))
(let ((tf (native-namestring (test-source "test-file"))))
;; a basic smoke test
(is (equal '("Single")
(run-program `("/bin/grep" "Single" ,tf) :output :lines)))
;; Make sure space is handled correctly
(is (equal '("double entry")
(run-program `("/bin/grep" "double entry" ,tf) :output :lines)))
;; Make sure space is handled correctly
(is (equal '("triple word entry")
(run-program `("/bin/grep" "triple word entry" ,tf) :output :lines)))
;; Testing special characters
(loop :for char :across "+-_.,%@:/\\!&*(){}"
:for str = (string char) :do
(is (equal (list (format nil "escape ~A" str))
(run-program
`("/bin/grep" ,(format nil "[~A]" str) ,tf)
:output :lines))))
;; Test that run-program signals an error
;; with an executable that doesn't return 0
(signals subprocess-error (run-program '("/bin/false") :output :lines))
;; Test that we can suppress the error on run-program
(is (null (run-program '("/bin/false")
:output :lines :ignore-error-status t))))
t)
(defun windows-only-test/run-program ()
;; a basic smoke test
(is (equal (run-program '("cmd" "/c" "echo" "ok") :output :lines)
'(("ok"))))
t)
(deftest test/run-program ()
#+os-unix (common-test/run-program)
#+os-unix (unix-only-test/run-program)
#+os-windows (windows-only-test/run-program)
(terpri)
t)
(test/run-program)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment