From ee0152431cb5e12befc4ef42470ae39ff4321efb Mon Sep 17 00:00:00 2001 From: Elias Pipping Date: Tue, 6 Sep 2016 12:22:24 +0000 Subject: [PATCH 1/2] Implement ext:terminate-process --- CHANGELOG | 3 +++ src/c/symbols_list.h | 1 + src/c/symbols_list2.h | 1 + src/c/unixsys.d | 27 +++++++++++++++++++++++++++ src/cmp/proclamations.lsp | 1 + src/h/external.h | 2 +- 6 files changed, 34 insertions(+), 1 deletion(-) diff --git a/CHANGELOG b/CHANGELOG index 14f309400..7e0bdb27a 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -39,6 +39,9 @@ arity dependent on platform) is also possible. - ext:random-state-array: new extension for random-states. Usage: =(ext:random-state-array random-state)=. +- ext:terminate-process: new extension for external processes. Usage: +=(ext:terminate-process process)= with a second, optional argument. + ** Enhancements - Initial port for the Haiku platform The port is done by Kacper Kasper's work, one of Haiku developers. diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 81e099a16..632a029c6 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1225,6 +1225,7 @@ cl_symbols[] = { {SYS_ "REPLACE-ARRAY", SI_ORDINARY, si_replace_array, 2, OBJNULL}, {SYS_ "ROW-MAJOR-ASET", SI_ORDINARY, si_row_major_aset, 3, OBJNULL}, {EXT_ "RUN-PROGRAM", EXT_ORDINARY, si_run_program, -1, OBJNULL}, +{EXT_ "TERMINATE-PROCESS", EXT_ORDINARY, ext_terminate_process, -1, OBJNULL}, {SYS_ "WAIT-FOR-ALL-PROCESSES", SI_ORDINARY, si_wait_for_all_processes, -1, OBJNULL}, {EXT_ "SAFE-EVAL", EXT_ORDINARY, ECL_NAME(si_safe_eval), -1, OBJNULL}, {SYS_ "SCH-FRS-BASE", SI_ORDINARY, si_sch_frs_base, 2, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 8c90e3b1c..ebf2be93e 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1225,6 +1225,7 @@ cl_symbols[] = { {SYS_ "REPLACE-ARRAY","si_replace_array"}, {SYS_ "ROW-MAJOR-ASET","si_row_major_aset"}, {EXT_ "RUN-PROGRAM","si_run_program"}, +{EXT_ "TERMINATE-PROCESS","ext_terminate_process"}, {SYS_ "WAIT-FOR-ALL-PROCESSES","si_wait_for_all_processes"}, {EXT_ "SAFE-EVAL","ECL_NAME(si_safe_eval)"}, {SYS_ "SCH-FRS-BASE","si_sch_frs_base"}, diff --git a/src/c/unixsys.d b/src/c/unixsys.d index b875e56f0..3daf1b738 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -301,6 +301,33 @@ ecl_waitpid(cl_object pid, cl_object wait) @(return status code pid); } +@(defun ext::terminate-process (process &optional (force ECL_NIL)) + @ + { + cl_env_ptr env = ecl_process_env(); + bool error_encountered = FALSE; + ECL_WITH_SPINLOCK_BEGIN(env, &cl_core.external_processes_lock); + { + cl_object pid = external_process_pid(process); + if (!Null(pid)) { + int ret; +#if defined(ECL_MS_WINDOWS_HOST) + ret = TerminateProcess(ecl_fixnum(pid), -1); + error_encountered = (ret == 0); +#else + ret = kill(ecl_fixnum(pid), Null(force) ? SIGTERM : SIGKILL); + error_encountered = (ret != 0); +#endif + } + } + ECL_WITH_SPINLOCK_END; + if (error_encountered) + FEerror("Cannot terminate the process ~A", 1, process); + return ECL_NIL; + } + @) + + @(defun si::wait-for-all-processes (&key (process ECL_NIL)) @ { diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 671d1abb9..22531484e 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -1329,6 +1329,7 @@ (values (or null two-way-stream) (or null integer) ext:external-process)) +(proclamation ext:terminate-process (t &optional gen-bool) null) (proclamation ext:make-weak-pointer (t) ext:weak-pointer :no-side-effects) (proclamation ext:weak-pointer-value (ext:weak-pointer) t) diff --git a/src/h/external.h b/src/h/external.h index 285b06d36..79b8d827a 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1891,7 +1891,7 @@ extern ECL_API cl_object si_make_pipe(); extern ECL_API cl_object si_run_program _ECL_ARGS((cl_narg narg, cl_object command, cl_object args, ...)); extern ECL_API cl_object si_external_process_wait _ECL_ARGS((cl_narg narg, cl_object h, ...)); extern ECL_API cl_object si_close_windows_handle(cl_object h); - +extern ECL_API cl_object ext_terminate_process _ECL_ARGS((cl_narg narg, cl_object process, ...)); /* unicode -- no particular file, but we group these changes here */ From 0d3ef482cf57852cc2dea2376e7eee547fe9df6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 7 Sep 2016 09:31:33 +0200 Subject: [PATCH 2/2] tests: add external process API suite --- src/tests/ecl-tests.asd | 3 ++- src/tests/ecl-tests.lisp | 4 +++- src/tests/features/external-process.lsp | 27 +++++++++++++++++++++++++ 3 files changed, 32 insertions(+), 2 deletions(-) create mode 100644 src/tests/features/external-process.lsp diff --git a/src/tests/ecl-tests.asd b/src/tests/ecl-tests.asd index 1738fd1cd..08b644427 100644 --- a/src/tests/ecl-tests.asd +++ b/src/tests/ecl-tests.asd @@ -22,7 +22,8 @@ :default-component-class asdf:cl-source-file.lsp :components ((:file "external-formats" :if-feature :unicode) - (:file "ieee-fp" :if-feature :ieee-floating-point))))) + (:file "ieee-fp" :if-feature :ieee-floating-point) + (:file "external-process"))))) (asdf:defsystem #:ecl-tests/stress :serial t diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index b5761d63b..46b78ce40 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -27,6 +27,7 @@ (suite 'make-check '(features/eformat features/ieee-fp + features/eprocess regressions/ansi+ regressions/mixed regressions/cmp @@ -47,7 +48,8 @@ (suite 'features '(features/eformat - features/ieee-fp)) + features/ieee-fp + features/eprocess)) ;;; Some syntactic sugar for 2am diff --git a/src/tests/features/external-process.lsp b/src/tests/features/external-process.lsp new file mode 100644 index 000000000..d65059ce6 --- /dev/null +++ b/src/tests/features/external-process.lsp @@ -0,0 +1,27 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*- +;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab: + +;;;; Author: Daniel Kochmański +;;;; Created: 2016-09-07 +;;;; Contains: External process interaction API +;;;; + +(in-package :cl-test) + +(suite 'features/eprocess) + +(test external-process.0001.run-program/wait/terminate + (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))))