From ccacf11cbc6fcb8d2f43f37490c56a8f93184afc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 20 Feb 2017 15:22:41 +0100 Subject: [PATCH] run-program: add preliminary test suite --- .../auxiliary/external-process-programs.lisp | 46 ++++++ src/tests/ecl-tests.asd | 1 + src/tests/ecl-tests.lisp | 4 +- src/tests/normal-tests/mixed.lsp | 21 --- src/tests/normal-tests/run-program.lsp | 137 ++++++++++++++++++ 5 files changed, 186 insertions(+), 23 deletions(-) create mode 100644 src/tests/auxiliary/external-process-programs.lisp create mode 100644 src/tests/normal-tests/run-program.lsp diff --git a/src/tests/auxiliary/external-process-programs.lisp b/src/tests/auxiliary/external-process-programs.lisp new file mode 100644 index 000000000..bb6de41cd --- /dev/null +++ b/src/tests/auxiliary/external-process-programs.lisp @@ -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))) diff --git a/src/tests/ecl-tests.asd b/src/tests/ecl-tests.asd index 9a12e1174..bab5acfc3 100644 --- a/src/tests/ecl-tests.asd +++ b/src/tests/ecl-tests.asd @@ -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) diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index 03957aecf..963294b3a 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -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 diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index 8203eab14..f2ddf9a73 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -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 diff --git a/src/tests/normal-tests/run-program.lsp b/src/tests/normal-tests/run-program.lsp new file mode 100644 index 000000000..bcbaa9c2d --- /dev/null +++ b/src/tests/normal-tests/run-program.lsp @@ -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)))))