Use optima, not fare-matcher. Fix tests.

diff --git a/inferior-shell.asd b/inferior-shell.asd
index a1abfc9..fca23d8 100644 (file)
--- a/inferior-shell.asd
+++ b/inferior-shell.asd
@@ -1,10 +1,9 @@
 ;;; -*- Lisp -*-
 
-#+sbcl (require :sb-posix)
-
 (defsystem :inferior-shell
   :defsystem-depends-on (:asdf-condition-control)
-  :depends-on (:asdf :xcvb-driver :fare-utils :fare-matcher :fare-quasiquote-readtable :fare-mop :alexandria)
+  :depends-on (:asdf :xcvb-utils :fare-quasiquote-extras :fare-mop :alexandria
+                     #+sbcl :sb-posix)
   :description "spawn local or remote processes and shell pipes"
   :components
   ((:file "pkgdcl")

diff --git a/pkgdcl.lisp b/pkgdcl.lisp
index 2118fea..16d6fb6 100644 (file)
--- a/pkgdcl.lisp
+++ b/pkgdcl.lisp
@@ -3,7 +3,7 @@
 (in-package :cl)
 
 (defpackage :inferior-shell
-  (:use :cl :xcvb-utils :fare-matcher :named-readtables :fare-mop)
+  (:use :cl :xcvb-utils :optima :named-readtables :fare-mop)
   (:export
    #:run #:run/s #:run/ss #:run/lines
    #:simple-command-line-token #:token-string

diff --git a/process-spec.lisp b/process-spec.lisp
index c15e6aa..a17c403 100644 (file)
--- a/process-spec.lisp
+++ b/process-spec.lisp
@@ -1,8 +1,8 @@
 #+xcvb (module (:depends-on ("pkgdcl")))
 
 (in-package :inferior-shell)
-(in-readtable :fare-quasiquote)
 
+(in-readtable :fare-quasiquote)
 
 (defclass process-spec (simple-print-object-mixin) ())
 
@@ -193,12 +193,12 @@
         (make-sequence-instance progn-spec args))
       (`(fork ,@args)
         (make-sequence-instance fork-spec args))
-      (`(,* ,@*)
+      (`(,_ ,@_)
         (let ((c (make-instance 'command-parse)))
           (dolist (elem spec)
             (parse-command-spec-top-token c elem))
           (command-parse-results c)))
-      (*
+      (_
        (error "Invalid process spec ~S" spec)))))
 
 (deftype simple-command-line-token () '(or string pathname keyword symbol character integer))
@@ -206,20 +206,31 @@
 (defun token-string (x)
   (with-safe-io-syntax ()
     (typecase x
+      (null "")
       (character (format nil "-~A" x))
       (keyword (format nil "--~(~A~)" x))
       (symbol (string-downcase x))
       (string x)
       (pathname (native-namestring (translate-logical-pathname x)))
-      (list (write-to-string x))
+      (cons (with-output-to-string (s) (mapcar (curry 'write-token-component s) x)))
       (t (princ-to-string x)))))
 
+(defun write-token-component (s x)
+  (typecase x
+    (null nil)
+    (character (write-char x s))
+    (symbol (write-string (string-downcase x) s))
+    (string (write-string x s))
+    (pathname (write-string (native-namestring (translate-logical-pathname x)) s))
+    (cons (mapcar (curry 'write-token-component s) x))
+    (t (princ x s))))
+
 (defun parse-command-spec-top-token (c x)
   (labels
       ((r (x)
          (add-redirection c x))
        (f (sym fd pn flags)
-         (r (make-file-redirection sym fd pn flags)))
+         (r (make-file-redirection sym fd (token-string pn) flags)))
        (fd (old new)
          (r (make-fd-redirection old new)))
        (cl (old)
@@ -276,7 +287,7 @@
            (`(>>&! ,pn)
              (c `(>>! 1 ,pn))
              (c `(>& 2 1)))
-           (*
+           (_
             (flush-argument c)
             (parse-command-spec-token c x)
             (flush-argument c)))))
@@ -306,9 +317,9 @@
            (`(quote ,@args) ;; quote
              (e (xcvb-driver:escape-command
                  (parse-command-spec-tokens args))))
-           (`(,(of-type simple-command-line-token) ,@*) ;; recurse
+           (`(,(typep simple-command-line-token) _) ;; recurse
              (map () #'p x))
-           (*
+           (_
             (error "Unrecognized command-spec token ~S" x)))))
     (p x)))
 

diff --git a/run-sbcl.lisp b/run-sbcl.lisp
index 63ec437..30174be 100644 (file)
--- a/run-sbcl.lisp
+++ b/run-sbcl.lisp
@@ -57,6 +57,6 @@
         (let ((collected (mapcar #'collect-threads full-results)))
           (case output
             (:string (apply #'concatenate 'string collected))
-            (:string/stripped (strcat collected))
+            (:string/stripped (stripln (apply #'concatenate 'string collected)))
             (:lines (apply #'concatenate 'list collected))
             (otherwise collected)))))))