mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-22 20:42:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

run-program: add preliminary test suite

Browse source
This commit is contained in:
Daniel Kochmański 2017-02-20 15:22:41 +01:00
parent abf580c9e4
commit ccacf11cbc
5 changed files with 186 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

46
src/tests/auxiliary/external-process-programs.lisp Normal file
View file

@ -0,0 +1,46 @@
(in-package #:cl-user)
(defmacro define-function (name &body body)
`(defun ,name (&aux
(argc (si:argc))
(argv (ext:command-args)))
(declare (ignorable argc argv))
,@body))
(define-function arg-test
(if (= argc *args-number*)
(quit 0)
(quit 1)))
(define-function print-test
(terpri *standard-output*)
(princ "Hello stdout" *standard-output*)
(terpri *error-output*)
(princ "Hello stderr" *error-output*))
(define-function io/err
(princ "Welcome to ITP(NR) - Intelligent Test Program (not really)!")
(print argc *error-output*)
(princ "Type your SEXP: ")
(let ((result (read *standard-input* nil :eof)))
(princ result *error-output*)
(cond ((eq result :eof)
(princ "No? Shame...")
(quit 1))
(:otherwise
"Thank you. Your wish has been heard loud and clear."
(quit 0)))))
(define-function terminate
;; timeout is for case of zombies, this process should be killed
;; from the outside.
(sleep 10)
(quit 0))
(define-function suspend
(do () (nil)
(print "heartbit")
(sleep 1)
(print "boombaya")
(sleep 1)))

1
src/tests/ecl-tests.asd
View file

@ -16,6 +16,7 @@
(:file "mixed")
(:file "compiler")
(:file "executable-cli")
(:file "run-program")
(:file "multiprocessing" :if-feature :threads)
(:file "embedding" :if-feature (:not :ecl-bytecmp))
(:file "foreign-interface" :if-feature :ffi)

4
src/tests/ecl-tests.lisp
View file

@ -22,11 +22,11 @@
;;;; Declare the suites
(suite 'ecl-tests
'(executable eformat ieee-fp eprocess package-locks ansi+ mixed
cmp emb ffi mop mp))
cmp emb ffi mop mp run-program))
(suite 'make-check
'(executable ieee-fp eprocess package-locks ansi+ mixed cmp emb
ffi mop))
ffi mop run-program))
;;; Some syntactic sugar for 2am

21
src/tests/normal-tests/mixed.lsp
View file

@ -173,27 +173,6 @@
(fail (ext:file-stream-fd (make-string-output-stream))
"Not-file stream would cause internal error on this ECL (skipped)")))
;;;; Author: Daniel Kochmański
;;;; Created: 2016-09-07
;;;; Contains: External process interaction API
;;;;
(test mix.0011.run-program
(let ((p (nth-value 2 (ext:run-program #-windows "sleep"
#+windows "timeout"
(list "3") :wait nil))))
(is (eql :running (ext:external-process-wait p nil))
"process doesn't run")
(ext:terminate-process p)
(sleep 1)
(multiple-value-bind (status code)
(ext:external-process-wait p nil)
(is (eql :signaled status)
"status is ~s, should be ~s" status :signalled)
(is (eql ext:+sigterm+ code)
"signal code is ~s, should be ~s" code ext:+sigterm+))
(finishes (ext:terminate-process p))))
;;; Date: 2016-12-20
;;; Reported by: Kris Katterjohn

137
src/tests/normal-tests/run-program.lsp Normal file
View file

@ -0,0 +1,137 @@
(in-package :cl-test)
(suite 'run-program)
;;
;; ;;;; Author: Daniel Kochmański
;; ;;;; Created: 2016-09-07
;; ;;;; Contains: External process interaction API
;; ;;;;
;; (test run-program.0001
;; (let ((p (nth-value 2 (ext:run-program #-windows "sleep"
;; #+windows "timeout"
;; (list "3") :wait nil))))
;; (is (eql :running (ext:external-process-wait p nil))
;; "process doesn't run")
;; (ext:terminate-process p)
;; (sleep 1)
;; (multiple-value-bind (status code)
;; (ext:external-process-wait p nil)
;; (is (eql :signaled status)
;; "status is ~s, should be ~s" status :signalled)
;; (is (eql ext:+sigterm+ code)
;; "signal code is ~s, should be ~s" code ext:+sigterm+))
;; (finishes (ext:terminate-process p))))
;; (test run-program.0002
;; (is (eql (nth-value 1 (ext:run-program "ip" '("/all"))) 0))
;; (multiple-value-bind (s c)
;; (is)))
;;; I was wondering about the program which we could could use to test
;;; the interface (i.e both on Linux and Windows). Easy! ECL is a
;;; perfect program for that.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *binary* (si:argv 0))
(defparameter *program* (namestring (merge-pathnames "external-process-programs.lisp" *aux-dir*))))
(defmacro with-run-program ((name args &rest params) &body body)
`(multiple-value-bind (,name code process)
(ext:run-program *binary*
'("--norc"
"--eval" ,(format nil "(setf *args-number* ~a)" (+ 13 (length args)))
"--eval" "(setf *load-verbose* nil)"
"--load" ,*program*
"--eval" ,(format nil "(~a)" name)
"--eval" "(quit)"
"--" ,@args)
,@params
:wait nil)
(declare (ignorable ,name code))
(let ((result (progn ,@body)))
(cons result (multiple-value-list (ext:external-process-wait process t))))))
(defmacro with-run-program2 ((name args &rest params) &body body)
`(multiple-value-bind (,name code process)
(ext:run-program *binary*
'("--norc"
"--eval" ,(format nil "(setf *args-number* ~a)" (+ 13 (length args)))
"--eval" "(setf *load-verbose* nil)"
"--load" ,*program*
"--eval" ,(format nil "(~a)" name)
"--eval" "(quit)"
"--" ,@args)
,@params
:wait nil)
(list ,name code process)))
(defun slurp (stream)
(do ((line #1=(read-line stream nil :eof) #1#)
(last nil line))
((eql line :eof) last)))
(test arg-test
(is (equal '(nil :exited 0)
(with-run-program (arg-test ("a" "b c" "d \\" "e\ 4\\
")))) "ext:run-program doesn't escape arguments properly"))
(test output-streams
;; error is a separate stream
(is-equal '(("Hello stdout" "Hello stderr") :exited 0)
(with-run-program
(print-test nil :output :stream :error :stream)
(let ((print-test-err (ext:external-process-error-stream process)))
(list (slurp print-test) (slurp print-test-err)))))
;; :error :output
(is-equal '(("Hello stderr" nil) :exited 0)
(with-run-program
(print-test nil :output :stream :error :output)
(let ((print-test-err (ext:external-process-error-stream process)))
;; print-test-err is drained by reading from print-test
(list (slurp print-test) (slurp print-test-err))))))
(test interactive-input
(is-equal '(nil :exited 0)
(with-run-program (io/err nil)
(format io/err "42~%")))
;; process will have :eof on input and should quit with "1"
(is-equal '(nil :exited 1) (with-run-program (io/err nil :input nil))))
(test terminate-process
(is-equal `(t :signaled ,ext:+sigterm+)
(with-run-program (terminate nil)
(is-eql :running (ext:external-process-wait process nil))
(finishes (ext:terminate-process process))
(finishes (ext:terminate-process process)) ; no-op
(sleep 1)
(is-eql :signaled (ext:external-process-wait process nil))
(finishes (ext:terminate-process process))))
(is-equal `(t :signaled ,ext:+sigkill+)
(with-run-program (terminate nil)
(is-eql :running (ext:external-process-wait process nil))
(finishes (ext:terminate-process process t))
(finishes (ext:terminate-process process t)) ; no-op
(sleep 1)
(is-eql :signaled (ext:external-process-wait process nil))
(finishes (ext:terminate-process process t)))))
;;; We may want to craft it into an interface. Suspend/Resume *is*
;;; possible on Windows:
;;; http://stackoverflow.com/questions/11010165/how-to-suspend-resume-a-process-in-windows
#-windows
(test suspend-resume
(let ((process (nth-value 2 (ext:run-program "sleep" '("100") :wait nil))))
(let ((pid (ext:external-process-pid process)))
(is-eql :running (ext:external-process-wait process nil))
(si:killpid pid ext:+sigstop+)
(sleep 2)
(is-eql :stopped (ext:external-process-wait process nil))
(si:killpid pid ext:+sigcont+)
(sleep 2)
(is-eql :resumed (ext:external-process-wait process nil))
(finishes (ext:terminate-process process t)))))