Merge branch 'pipping/ecl-develop' into develop

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.

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},

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"},

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))
   @
   {

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)

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 */
 

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

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

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))))