1.1--- a/lisp/lib/cli/clap/cli.lisp Mon Sep 30 22:27:12 2024 -0400
1.2+++ b/lisp/lib/cli/clap/cli.lisp Tue Oct 01 21:52:17 2024 -0400
1.3@@ -48,8 +48,7 @@
1.4 (lambda (x)
1.5 (etypecase x
1.6 (string (make-cli-opt :name x))
1.7- (list (apply #'make-cli :opt x))
1.8- (t (make-cli :opt :name (format nil "~(~A~)" x) :global t))))
1.9+ (list (apply #'make-cli :opt x))))
1.10 opts))
1.11
1.12 (defun make-cmds (cmds)
1.13@@ -73,7 +72,7 @@
1.14 (:documentation "CLI"))
1.15
1.16 (defmethod print-usage ((self cli) &optional stream)
1.17- (iprintln (format nil "usage: ~A [global] <command> [<arg>]~%" (cli-name self)) 2 stream))
1.18+ (iprintln (format nil "usage: ~A [opts] <command> [<arg>]~%" (cli-name self)) 2 stream))
1.19
1.20 (defmethod print-version ((self cli) &optional stream)
1.21 (println (cli-version self) stream))
1.22@@ -105,7 +104,7 @@
1.23 (declaim (inline debug-opts))
1.24 (defun debug-opts (cli)
1.25 (let ((o (active-opts cli))
1.26- (a (cli-cmd-args cli))
1.27+ (a (cli-args cli))
1.28 (c (active-cmds cli)))
1.29 (log:debug! :pwd (cli-cd cli) :active-opts o :cmd-args a :active-cmds c)))
1.30
2.1--- a/lisp/lib/cli/clap/cmd.lisp Mon Sep 30 22:27:12 2024 -0400
2.2+++ b/lisp/lib/cli/clap/cmd.lisp Tue Oct 01 21:52:17 2024 -0400
2.3@@ -19,7 +19,7 @@
2.4 (thunk :initform 'default-thunk :initarg :thunk :accessor cli-thunk :type symbol)
2.5 (lock :initform nil :initarg :lock :accessor cli-lock-p :type boolean)
2.6 (description :initarg :description :accessor cli-description :type string)
2.7- (args :initform nil :initarg :args :accessor cli-cmd-args))
2.8+ (args :initform nil :initarg :args :accessor cli-args))
2.9 (:documentation "CLI command class inherited by both the 'main' command which is executed when
2.10 a CLI is called without arguments, and all subcommands."))
2.11
2.12@@ -38,11 +38,12 @@
2.13
2.14 (defmethod print-object ((self cli-cmd) stream)
2.15 (print-unreadable-object (self stream :type t)
2.16- (format stream "~A :opts ~A :cmds ~A :args ~A"
2.17+ (format stream "~A :active ~a :opts ~A :cmds ~A :args ~A"
2.18 (cli-name self)
2.19+ (cli-lock-p self)
2.20 (length (opts self))
2.21 (length (cmds self))
2.22- (length (cli-cmd-args self)))))
2.23+ (length (cli-args self)))))
2.24
2.25 (defmethod print-usage ((self cli-cmd) &optional stream)
2.26 (with-slots (opts cmds) self
2.27@@ -138,12 +139,8 @@
2.28 (let ((match (find-opt self name active)))
2.29 (substitute new match (opts self) :test 'cli-equal)))
2.30
2.31-(defmethod active-opts ((self cli-cmd) &optional global)
2.32- (remove-if-not
2.33- (if global
2.34- #'active-global-opt-p
2.35- #'cli-opt-lock)
2.36- (opts self)))
2.37+(defmethod active-opts ((self cli-cmd))
2.38+ (remove-if-not 'cli-opt-lock (opts self)))
2.39
2.40 (defmethod find-short-opts ((self cli-cmd) ch &key recurse)
2.41 (let ((ret))
2.42@@ -245,7 +242,7 @@
2.43 (setf (find-cmd self (cli-name form)) form)
2.44 (log:trace! (format nil "installing cmd ~A" (cli-name form))))
2.45 (arg (push-arg form self)))))
2.46- (setf (cli-cmd-args self) (nreverse (cli-cmd-args self)))
2.47+ (setf (cli-args self) (nreverse (cli-args self)))
2.48 self))
2.49
2.50 (defmethod install-thunk ((self cli-cmd) (lambda function) &optional compile)
2.51@@ -256,7 +253,7 @@
2.52
2.53 (defmethod push-arg (arg (self cli-cmd))
2.54 "Push an ARG onto the corresponding slot of a CLI-CMD."
2.55- (push arg (cli-cmd-args self)))
2.56+ (push arg (cli-args self)))
2.57
2.58 (defmethod parse-args ((self cli-cmd) args &key (compile t))
2.59 "Parse ARGS and return the updated object SELF.
2.60@@ -272,8 +269,8 @@
2.61 (trace! "calling command:" args opts)
2.62 (funcall (cli-thunk self) args opts))
2.63
2.64-(defmethod do-opts ((self cli-cmd) &optional global)
2.65- (do-opts (active-opts self) global))
2.66+(defmethod do-opts ((self cli-cmd))
2.67+ (do-opts (active-opts self)))
2.68
2.69 (defmethod do-cmd ((self cli-cmd))
2.70 "Perform the active command or subcommand, recursively calling DO-CMD on
2.71@@ -281,7 +278,11 @@
2.72 evaluated with DO-OPTS along the way."
2.73 (do-opts self)
2.74 (if (solop self)
2.75- (call-cmd self (cli-cmd-args self) (active-opts self))
2.76+ (prog1 (call-cmd self (cli-args self) (active-opts self))
2.77+ ;; release opts
2.78+ (loop for o across (active-opts self)
2.79+ do (setf (cli-opt-lock o) nil)))
2.80 (loop for c across (active-cmds self)
2.81- do (do-cmd c))))
2.82+ do (do-cmd c)))
2.83+ (setf (cli-lock-p self) nil))
2.84
3.1--- a/lisp/lib/cli/clap/opt.lisp Mon Sep 30 22:27:12 2024 -0400
3.2+++ b/lisp/lib/cli/clap/opt.lisp Tue Oct 01 21:52:17 2024 -0400
3.3@@ -38,7 +38,6 @@
3.4 (kind 'boolean :type (or symbol list))
3.5 (thunk 'identity :type symbol)
3.6 (val nil)
3.7- (global nil :type boolean)
3.8 (description nil :type (or null string))
3.9 (lock nil :type boolean))
3.10
3.11@@ -48,6 +47,9 @@
3.12 (defmethod activate-opt ((self cli-opt))
3.13 (setf (cli-opt-lock self) t))
3.14
3.15+(defmethod cli-lock-p ((self cli-opt))
3.16+ (cli-opt-lock self))
3.17+
3.18 (defun %compose-short-opt (o)
3.19 (setf (cli-opt-val o) t)
3.20 (make-cli-node 'opt o))
3.21@@ -72,7 +74,7 @@
3.22 (defmethod make-load-form ((obj cli-opt) &optional env)
3.23 (make-load-form-saving-slots
3.24 obj
3.25- :slot-names '(name kind thunk val global description lock)
3.26+ :slot-names '(name kind thunk val description lock)
3.27 :environment env))
3.28
3.29 (defmethod install-thunk ((self cli-opt) (lambda function) &optional compile)
3.30@@ -83,26 +85,24 @@
3.31
3.32 (defmethod print-object ((self cli-opt) stream)
3.33 (print-unreadable-object (self stream :type t)
3.34- (format stream "~A :global ~A :val ~A"
3.35+ (format stream "~A :active ~A :val ~A"
3.36 (cli-opt-name self)
3.37- (cli-opt-global self)
3.38+ (cli-opt-lock self)
3.39 (cli-opt-val self))))
3.40
3.41 (defmethod print-usage ((self cli-opt) &optional stream)
3.42- (format stream "-~(~{~A~^/--~}~)~A~A"
3.43+ (format stream "-~(~{~A~^/--~}~) ~A"
3.44 (let ((n (cli-opt-name self)))
3.45 (declare (simple-string n))
3.46 (list (make-shorty n) n))
3.47- (if (cli-opt-global self) "* " " ")
3.48 (if-let ((d (and (slot-boundp self 'description) (cli-opt-description self))))
3.49 (format stream ": ~A" d)
3.50 "")))
3.51
3.52 (defmethod cli-equal ((a cli-opt) (b cli-opt))
3.53- (with-slots (name global kind) a
3.54- (with-slots ((bn name) (bg global) (bk kind)) b
3.55+ (with-slots (name kind) a
3.56+ (with-slots ((bn name) (bk kind)) b
3.57 (and (equal name bn)
3.58- (eq global bg)
3.59 (equal kind bk)))))
3.60
3.61 (defmethod call-opt ((self cli-opt) arg)
3.62@@ -111,13 +111,6 @@
3.63 (defmethod do-opt ((self cli-opt))
3.64 (setf (cli-opt-val self) (call-opt self (cli-opt-val self))))
3.65
3.66-(defmethod do-opts ((self vector) &optional global)
3.67+(defmethod do-opts ((self vector))
3.68 (loop for opt across self
3.69- do (if global
3.70- (when (cli-opt-global opt)
3.71- (do-opt opt))
3.72- (do-opt opt))))
3.73-
3.74-(defun active-global-opt-p (opt)
3.75- "Return non-nil if OPT is active at runtime and global."
3.76- (and (cli-opt-lock opt) (cli-opt-global opt)))
3.77+ do (do-opt opt)))
4.1--- a/lisp/lib/cli/clap/pkg.lisp Mon Sep 30 22:27:12 2024 -0400
4.2+++ b/lisp/lib/cli/clap/pkg.lisp Tue Oct 01 21:52:17 2024 -0400
4.3@@ -25,6 +25,7 @@
4.4
4.5 (defpackage :cli/clap/proto
4.6 (:use :cl :std :log :sb-ext)
4.7+ (:import-from :cli/clap/util :args)
4.8 (:export :proc-args :clap-error :find-short-opts
4.9 :find-cmd :find-opts :parse-args :print-help
4.10 :print-usage :print-version :do-cmds :do-cmd
4.11@@ -45,7 +46,10 @@
4.12 :clap-invalid-argument
4.13 :activate-cmd
4.14 :activate-opt
4.15- :find-opt))
4.16+ :find-opt
4.17+ :cli-args
4.18+ :opts
4.19+ :cmds))
4.20
4.21 (defpackage :cli/clap/ast
4.22 (:use :cl :std :log :dat/sxp)
4.23@@ -61,10 +65,13 @@
4.24 :make-opts :make-cmds :parse-bool-opt :parse-string-opt
4.25 :parse-form-opt :parse-list-op :parse-sym-op :parse-key-op
4.26 :pasre-num-op :parse-file-op :parse-dir-op :cli
4.27- :cli-cd :with-cli :opts :cmds :debug-opts
4.28+ :cli-cd :with-cli :debug-opts
4.29 :cli-opt :cli-cmd :cli-opt-val :cli-opt-lock :cli-opt-name
4.30 :active-cmds
4.31- :%compose-keyword-opt))
4.32+ :%compose-keyword-opt
4.33+ :cli-cmd-args
4.34+ :cli-lock-p
4.35+ :cli-name))
4.36
4.37 (defpackage :cli/clap/simple
4.38 (:use :cl :std :log :sb-ext)
5.1--- a/lisp/lib/cli/clap/proto.lisp Mon Sep 30 22:27:12 2024 -0400
5.2+++ b/lisp/lib/cli/clap/proto.lisp Tue Oct 01 21:52:17 2024 -0400
5.3@@ -25,6 +25,12 @@
5.4 (defun clap-invalid-argument (arg &key reason kind)
5.5 (error 'clap-invalid-argument :name arg :kind kind :reason reason))
5.6
5.7+(defgeneric cmds (self))
5.8+(defgeneric opts (self))
5.9+
5.10+(defgeneric cli-args (self)
5.11+ (:method ((self null)) (args)))
5.12+
5.13 (defgeneric push-cmd (cmd place))
5.14
5.15 (defgeneric push-opt (opt place))
5.16@@ -45,7 +51,7 @@
5.17
5.18 (defgeneric active-cmds (self))
5.19
5.20-(defgeneric active-opts (self &optional global))
5.21+(defgeneric active-opts (self))
5.22
5.23 (defgeneric activate-opt (self))
5.24
5.25@@ -57,7 +63,7 @@
5.26
5.27 (defgeneric do-opt (self))
5.28
5.29-(defgeneric do-opts (self &optional global))
5.30+(defgeneric do-opts (self))
5.31
5.32 (defgeneric call-cmd (self args opts))
5.33
6.1--- a/lisp/lib/cli/cli.asd Mon Sep 30 22:27:12 2024 -0400
6.2+++ b/lisp/lib/cli/cli.asd Tue Oct 01 21:52:17 2024 -0400
6.3@@ -39,5 +39,8 @@
6.4
6.5 (defsystem :cli/tests
6.6 :depends-on (:rt :cli)
6.7- :components ((:file "tests"))
6.8+ :components ((:module "tests"
6.9+ :components
6.10+ ((:file "pkg")
6.11+ (:file "clap"))))
6.12 :perform (test-op (o c) (symbol-call :rt :do-tests :cli)))
7.1--- a/lisp/lib/cli/tests.lisp Mon Sep 30 22:27:12 2024 -0400
7.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
7.3@@ -1,695 +0,0 @@
7.4-;;; cli/tests.lisp --- CLI Tests
7.5-
7.6-;;
7.7-
7.8-;;; Code:
7.9-(defpackage :cli/tests
7.10- (:use :cl :std :rt :cli :cli/shell :cli/progress :cli/spark :cli/repl :cli/ansi :cli/prompt :cli/clap :cli/tools/sbcl :dat/sxp))
7.11-
7.12-(in-package :cli/tests)
7.13-(declaim (optimize (debug 3) (safety 3)))
7.14-(defsuite :cli)
7.15-(in-suite :cli)
7.16-
7.17-(defun ansi-t01 ()
7.18- (erase)
7.19- (cursor-position 0 0)
7.20- (princ "0")
7.21- (cursor-position 2 2)
7.22- (princ "1")
7.23- (cursor-position 5 15)
7.24- (princ "test")
7.25- (cursor-position 10 15)
7.26- (force-output)
7.27- (with-input-from-string (in (format nil "test~%~%"))
7.28- (let ((a (read-line in)))
7.29- (cursor-position 12 15)
7.30- (princ a)
7.31- (force-output))))
7.32-
7.33-(defun ansi-t02 ()
7.34- (print "normal")
7.35- (.sgr 1)
7.36- (print "bold")
7.37- (.sgr 4)
7.38- (print "bold underline")
7.39- (.sgr 7)
7.40- (print "bold underline reverse")
7.41- (.sgr 22)
7.42- (print "underline reverse")
7.43- (.sgr 24)
7.44- (print "reverse")
7.45- (.sgr 27)
7.46- (print "normal")
7.47- (.sgr 1 4 7)
7.48- (print "bold underline reverse")
7.49- (.sgr 0)
7.50- (print "normal")
7.51- (force-output))
7.52-
7.53-(defun ansi-t03 ()
7.54- "Display the 256 color palette."
7.55- (clear)
7.56- (loop for i from 0 to 255 do
7.57- (.sgr 48 5 i)
7.58- (princ #\space))
7.59- (terpri)
7.60- (.sgr 0)
7.61- (loop for i from 0 to 255 do
7.62- (.sgr 38 5 i)
7.63- (princ "X"))
7.64- (.sgr 0)
7.65- (force-output)
7.66- ;; (sleep 3)
7.67- (.ris)
7.68- (force-output))
7.69-
7.70-(defun ansi-t04 ()
7.71- "Hide and show the cursor."
7.72- (princ "Cursor visible:")
7.73- (force-output)
7.74- ;; (sleep 2)
7.75- (terpri)
7.76- (princ "Cursor invisible:")
7.77- (hide-cursor)
7.78- (force-output)
7.79- ;; (sleep 2)
7.80- (terpri)
7.81- (princ "Cursor visible:")
7.82- (show-cursor)
7.83- (force-output)
7.84- ;; (sleep 2)
7.85- )
7.86-
7.87-(defun ansi-t05 ()
7.88- "Switch to and back from the alternate screen buffer."
7.89- (princ "Normal screen buffer. ")
7.90- (force-output)
7.91- ;; (sleep 2)
7.92- (save-cursor-position)
7.93- (use-alternate-screen-buffer)
7.94- (clear)
7.95- (princ "Alternate screen buffer.")
7.96- (force-output)
7.97- ;; (sleep 2)
7.98- (use-normal-screen-buffer)
7.99- (restore-cursor-position)
7.100- (princ "Back to Normal screen buffer.")
7.101- (force-output)
7.102- ;; (sleep 1)
7.103- )
7.104-
7.105-(defun ansi-t06 ()
7.106- "Set individual termios flags to enable raw and disable echo mode.
7.107-
7.108-Enabling raw mode allows read-char to return immediately after a key is pressed.
7.109-
7.110-In the default cooked mode, the entry has to be confirmed by pressing enter."
7.111- (set-tty-mode t :ignbrk nil
7.112- :brkint nil
7.113- :parmrk nil
7.114- :istrip nil
7.115- :inlcr nil
7.116- :igncr nil
7.117- :icrnl nil
7.118- :ixon nil
7.119- :opost nil
7.120- :echo nil
7.121- :echonl nil
7.122- :icanon nil
7.123- :isig nil
7.124- :iexten nil
7.125- :csize nil
7.126- :parenb nil
7.127- :vmin 1
7.128- :vtime 0)
7.129- (erase)
7.130- (cursor-position 1 1)
7.131- (force-output)
7.132- (let ((a (read-char)))
7.133- (cursor-position 10 5)
7.134- (princ a)
7.135- (force-output))
7.136-
7.137- (set-tty-mode t :echo t
7.138- :brkint t
7.139- :ignpar t
7.140- :istrip t
7.141- :icrnl t
7.142- :ixon t
7.143- :opost t
7.144- :isig t
7.145- :icanon t
7.146- :veol 0))
7.147-
7.148-(defun ansi-t07 ()
7.149- "Use combination modes that consist of several individual flags.
7.150-
7.151-Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa."
7.152- (set-tty-mode t :cooked nil)
7.153- (erase)
7.154- (cursor-position 1 1)
7.155- (force-output)
7.156- (let ((a (read-char)))
7.157- (cursor-position 3 1)
7.158- (princ a)
7.159- (force-output))
7.160- (set-tty-mode t :raw nil))
7.161-
7.162-(defun ansi-t08 ()
7.163- "Why doesnt calling the stty utility work?"
7.164- (uiop:run-program "stty raw -echo" :ignore-error-status t)
7.165- (erase)
7.166- (cursor-position 1 1)
7.167- (force-output)
7.168- (let ((a (read-char)))
7.169- (cursor-position 2 1)
7.170- (princ a)
7.171- (force-output))
7.172- (uiop:run-program "stty -raw echo" :ignore-error-status t))
7.173-
7.174-(defun ansi-t09 ()
7.175- "Query terminal size with ANSI escape sequences."
7.176- ;; Put the terminal into raw mode so we can read the "user input"
7.177- ;; of the reply char by char
7.178- ;; Turn off the echo or the sequence will be displayed
7.179- (set-tty-mode t :cooked nil :echo nil)
7.180- (save-cursor-position)
7.181- ;; Go to the bottom right corner of the terminal by attempting
7.182- ;; to go to some high value of row and column
7.183- (cursor-position 999 999)
7.184- (let (chars)
7.185- ;; The terminal returns an escape sequence to the standard input
7.186- (device-status-report)
7.187- (force-output)
7.188- ;; The reply isnt immediately available, the terminal does need
7.189- ;; some time to answer
7.190- (sleep 0.1)
7.191- ;; The reply has to be read as if the user typed an escape sequence
7.192- (loop for i = (read-char-no-hang *standard-input* nil)
7.193- until (null i)
7.194- do (push i chars))
7.195- ;; Put the terminal back into its initial cooked state
7.196- (set-tty-mode t :raw nil :echo t)
7.197- (restore-cursor-position)
7.198- ;; Return the read sequence as a list of characters.
7.199- (nreverse chars)))
7.200-
7.201-(deftest ansi ()
7.202- (with-input-from-string (in (format nil "~%~%"))
7.203- (ansi-t01)
7.204- (ansi-t02)
7.205- (ansi-t03)
7.206- (ansi-t04)
7.207- (ansi-t05)))
7.208-
7.209-;; TODO: needs to be compiled outside scope of test - contender for
7.210-;; fixture API
7.211-(defprompt tpfoo :prompt "testing:")
7.212-
7.213-(deftest cli-prompt (:skip t)
7.214- "Test CLI prompts"
7.215- (defvar tcoll nil)
7.216- (defvar thist nil)
7.217- (let ((*standard-input* (make-string-input-stream
7.218- (format nil "~A~%~A~%~%" "foobar" "foobar"))))
7.219- ;; prompts
7.220- (is (string= (tpfoo-prompt) "foobar"))
7.221- (is (string= "foobar"
7.222- (completing-read "nothing: " tcoll :history thist :default "foobar")))))
7.223-
7.224-(defparameter *opts* '((:name "foo" :global t :description "bar" :kind string)
7.225- (:name "bar" :description "foo" :kind string)))
7.226-
7.227-(defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description"))
7.228-(defparameter *cmd2* (make-cli :cmd :name "ayo" :cmds (vector *cmd1*) :opts *opts* :description "cmd1 description"))
7.229-(defparameter *cmds* (make-cmds (list `(:name "baz" :description "baz" :opts ,*opts*) *cmd1* *cmd2*)))
7.230-
7.231-(defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli"))
7.232-
7.233-
7.234-(deftest clap-basic (:skip t)
7.235- "test basic CLAP functionality."
7.236- (is (eq (make-shorty "test") #\t))
7.237- (is (equalp (proc-args *cli* '("-f" "baz" "--bar=fax")) ;; not eql
7.238- (make-cli-ast
7.239- (list (make-cli-node 'opt (find-short-opts cli #\f))
7.240- (make-cli-node 'cmd (find-cmd cli "baz"))
7.241- (make-cli-node 'opt (find-opts cli "bar"))
7.242- (make-cli-node 'arg "fax")))))
7.243- (is (parse-args cli '("--bar" "baz" "-f" "yaks")))
7.244- (is (stringp
7.245- (with-output-to-string (s)
7.246- (print-version *cli* s)
7.247- (print-usage *cli* s)
7.248- (print-help *cli* s))))
7.249- (is (string= "foobar" (cli/clap:parse-string-opt "foobar"))))
7.250-
7.251-(make-opt-parser thing *arg*)
7.252-
7.253-(deftest clap-opts ()
7.254- "CLAP opt tests."
7.255- (is (reduce (lambda (x y) (and x y))
7.256- (loop for k across *cli-opt-kinds* collect (cli-opt-kind-p k))))
7.257- (is (parse-thing-opt t))
7.258- (is (null (parse-thing-opt nil))))
7.259-
7.260-(deftest progress ()
7.261- (flet ((%step () (cli/progress::update 1)))
7.262- (let ((*progress-bar-enabled* t)
7.263- (n 100))
7.264- (with-progress-bar (n "TEST: # of steps = ~a" n)
7.265- (dotimes (i n) (%step))))))
7.266-
7.267-(deftest spark ()
7.268- (is (string=
7.269- (spark '(1 5 22 13 5))
7.270- "▁▂█▅▂"))
7.271- (is (string=
7.272- (spark '(5.5 20))
7.273- "▁█"))
7.274- (is (string=
7.275- (spark '(1 2 3 4 100 5 10 20 50 300))
7.276- "▁▁▁▁▃▁▁▁▂█"))
7.277- (is (string=
7.278- (spark '(1 50 100))
7.279- "▁▄█"))
7.280- (is (string=
7.281- (spark '(2 4 8))
7.282- "▁▃█"))
7.283- (is (string=
7.284- (spark '(1 2 3 4 5))
7.285- "▁▂▄▆█"))
7.286- (is (string=
7.287- (spark '(0 30 55 80 33 150))
7.288- "▁▂▃▄▂█"))
7.289- ;; null
7.290- (is (string=
7.291- (spark '())
7.292- ""))
7.293- ;; singleton
7.294- (is (string=
7.295- (spark '(42))
7.296- "▁"))
7.297- ;; constant
7.298- (is (string=
7.299- (spark '(42 42))
7.300- "▁▁"))
7.301- ;; min/max
7.302- (is (string=
7.303- (spark '(0 30 55 80 33 150) :min -100)
7.304- "▃▄▅▆▄█"))
7.305- (is (string=
7.306- (spark '(0 30 55 80 33 150) :max 50)
7.307- "▁▅██▅█"))
7.308- (is (string=
7.309- (spark '(0 30 55 80 33 150) :min 30 :max 80)
7.310- "▁▁▄█▁█"))
7.311- ;; double-float, minus
7.312- (is (string=
7.313- (spark '(1.000000000005d0 0.000000000005d0 1.0d0))
7.314- "█▁▇"))
7.315- (is (string=
7.316- (spark '(-1 0 -1))
7.317- "▁█▁"))
7.318- (is (string=
7.319- (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0))
7.320- "▁█▁"))
7.321- ;; *ticks*
7.322- (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0)))
7.323- (is (string=
7.324- (spark ternary)
7.325- "▁▄█▁█▄▄▁██▄"))
7.326- (is (string=
7.327- (let ((*ticks* #(#\_ #\- #\¯)))
7.328- (spark ternary))
7.329- "_-¯_¯--_¯¯-"))
7.330- (is (string=
7.331- (let ((*ticks* #(#\▄ #\⎯ #\▀)))
7.332- (spark ternary))
7.333- "▄⎯▀▄▀⎯⎯▄▀▀⎯"))
7.334- (is (string=
7.335- (let ((*ticks* #(#\E #\O)))
7.336- (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2))))
7.337- "EEOEE")))
7.338- ;; key
7.339- (flet ((range (start end) (loop for i from start below end collect i))
7.340- (fib (n) (loop for x = 0 then y
7.341- and y = 1 then (+ x y)
7.342- repeat n
7.343- finally (return x)))
7.344- (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc)))))
7.345- (rec n 1))))
7.346- (is (string=
7.347- (spark (range 0 51)
7.348- :key (lambda (x) (sin (* x pi 1/4))))
7.349- "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█"))
7.350- (is (string=
7.351- (spark (range 0 51)
7.352- :key (lambda (x) (cos (* x pi 1/4))))
7.353- "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄"))
7.354-
7.355- (is (string=
7.356- (spark (range 0 51)
7.357- :key (lambda (x) (abs (cis (* x pi 1/4)))))
7.358- "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁"))
7.359-
7.360- (is (string=
7.361- (spark (range 0 51)
7.362- :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0)))
7.363- "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆"))
7.364-
7.365- (is (string=
7.366- (spark (range 1 7) :key #'log)
7.367- "▁▃▅▆▇█"))
7.368-
7.369- (is (string=
7.370- (spark (range 1 7) :key #'sqrt)
7.371- "▁▃▄▅▆█"))
7.372- (is (string=
7.373- (spark (range 1 7))
7.374- "▁▂▃▅▆█"))
7.375- (is (string=
7.376- (spark (range 1 7) :key #'fib)
7.377- "▁▁▂▃▅█"))
7.378- (is (string=
7.379- (spark (range 1 7) :key #'exp)
7.380- "▁▁▁▁▃█"))
7.381- (is (string=
7.382- (spark (range 1 7) :key #'fac)
7.383- "▁▁▁▁▂█"))
7.384- (is (string=
7.385- (spark (range 1 7) :key #'isqrt)
7.386- "▁▁▁███"))
7.387- ;; misc
7.388- (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2)))))
7.389- (is (string=
7.390- (lbits 42)
7.391- "█▁█▁█▁"))
7.392- (is (string=
7.393- (lbits 43)
7.394- "█▁█▁██"))
7.395- (is (string=
7.396- (lbits 44)
7.397- "█▁██▁▁"))
7.398- (is (string=
7.399- (lbits 45)
7.400- "█▁██▁█")))
7.401-
7.402- ;; VSPARK
7.403- (is (string=
7.404- (vspark '())
7.405- ""))
7.406- ;; singleton
7.407- (is (string=
7.408- (vspark '(1))
7.409- "
7.410-1 1.5 2
7.411-˫-----------------------+------------------------˧
7.412-▏
7.413-"))
7.414-
7.415- ;; constant
7.416- (is (string=
7.417- (vspark '(1 1))
7.418- "
7.419-1 1.5 2
7.420-˫-----------------------+------------------------˧
7.421-▏
7.422-▏
7.423-"))
7.424-
7.425-
7.426- (is (string=
7.427- (vspark '(0 30 55 80 33 150))
7.428- "
7.429-0 75 150
7.430-˫-----------------------+------------------------˧
7.431-▏
7.432-██████████▏
7.433-██████████████████▍
7.434-██████████████████████████▋
7.435-███████████▏
7.436-██████████████████████████████████████████████████
7.437-"))
7.438-
7.439-
7.440- ;; min, max
7.441-
7.442- (is (string=
7.443- (vspark '(0 30 55 80 33 150) :min -100)
7.444- "
7.445--100 25 150
7.446-˫-----------------------+------------------------˧
7.447-████████████████████▏
7.448-██████████████████████████▏
7.449-███████████████████████████████▏
7.450-████████████████████████████████████▏
7.451-██████████████████████████▋
7.452-██████████████████████████████████████████████████
7.453-"))
7.454-
7.455- (is (string=
7.456- (vspark '(0 30 55 80 33 150) :max 50)
7.457- "
7.458-0 25 50
7.459-˫-----------------------+------------------------˧
7.460-▏
7.461-██████████████████████████████▏
7.462-██████████████████████████████████████████████████
7.463-██████████████████████████████████████████████████
7.464-█████████████████████████████████▏
7.465-██████████████████████████████████████████████████
7.466-"))
7.467-
7.468-
7.469- (is (string=
7.470- (vspark '(0 30 55 80 33 150) :min 30 :max 80)
7.471- "
7.472-30 55 80
7.473-˫-----------------------+------------------------˧
7.474-▏
7.475-▏
7.476-█████████████████████████▏
7.477-██████████████████████████████████████████████████
7.478-███▏
7.479-██████████████████████████████████████████████████
7.480-"))
7.481-
7.482- ;; labels
7.483- (is (string=
7.484- (vspark '(1 0 .5) :labels '("on" "off" "unknown")
7.485- :size 1
7.486- :scale? nil)
7.487- "
7.488- on █
7.489- off ▏
7.490-unknown ▌
7.491-"))
7.492-
7.493- (is (string=
7.494- (vspark '(1 0 .5) :labels '("on" "off")
7.495- :size 1
7.496- :scale? nil)
7.497- "
7.498- on █
7.499-off ▏
7.500- ▌
7.501-"))
7.502-
7.503- (is (string=
7.504- (vspark '(1 0) :labels '("on" "off" "unknown")
7.505- :size 1
7.506- :scale? nil)
7.507- "
7.508- on █
7.509-off ▏
7.510-"))
7.511-
7.512- ;; key
7.513- (is (string=
7.514- (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))))
7.515- "
7.516--1.0 0.0 1.0
7.517-˫-----------------------+------------------------˧
7.518-█████████████████████████▏
7.519-██████████████████████████████████████████▋
7.520-██████████████████████████████████████████████████
7.521-██████████████████████████████████████████▋
7.522-█████████████████████████▏
7.523-███████▍
7.524-▏
7.525-███████▍
7.526-████████████████████████▉
7.527-"))
7.528-
7.529- ;; size
7.530- (is (string=
7.531- (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
7.532- :size 10)
7.533- "
7.534--1.0 1.0
7.535-˫--------˧
7.536-█████▏
7.537-████████▌
7.538-██████████
7.539-████████▌
7.540-█████▏
7.541-█▌
7.542-▏
7.543-█▌
7.544-████▉
7.545-"))
7.546-
7.547- ;; scale (mid-point)
7.548- (is (string=
7.549- (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
7.550- :size 20)
7.551- "
7.552--1.0 0.0 1.0
7.553-˫--------+---------˧
7.554-██████████▏
7.555-█████████████████▏
7.556-████████████████████
7.557-█████████████████▏
7.558-██████████▏
7.559-██▉
7.560-▏
7.561-██▉
7.562-█████████▉
7.563-"))
7.564-
7.565- (let ((life-expectancies '(("Africa" 56)
7.566- ("Americans" 76)
7.567- ("South-East Asia" 67)
7.568- ("Europe" 76)
7.569- ("Eastern Mediterranean" 68)
7.570- ("Western Pacific" 76)
7.571- ("Global" 70))))
7.572-
7.573- (is (string=
7.574- (vspark life-expectancies :key #'second)
7.575- "
7.576-56 66 76
7.577-˫-----------------------+------------------------˧
7.578-▏
7.579-██████████████████████████████████████████████████
7.580-███████████████████████████▌
7.581-██████████████████████████████████████████████████
7.582-██████████████████████████████▏
7.583-██████████████████████████████████████████████████
7.584-███████████████████████████████████▏
7.585-"))
7.586-
7.587- ;; newline?
7.588- (is (string=
7.589- (vspark life-expectancies :key #'second :scale? nil :newline? nil)
7.590- "▏
7.591-██████████████████████████████████████████████████
7.592-███████████████████████████▌
7.593-██████████████████████████████████████████████████
7.594-██████████████████████████████▏
7.595-██████████████████████████████████████████████████
7.596-███████████████████████████████████▏"))
7.597-
7.598- ;; scale?
7.599- (is (string=
7.600- (vspark life-expectancies :key #'second :scale? nil)
7.601- "
7.602-▏
7.603-██████████████████████████████████████████████████
7.604-███████████████████████████▌
7.605-██████████████████████████████████████████████████
7.606-██████████████████████████████▏
7.607-██████████████████████████████████████████████████
7.608-███████████████████████████████████▏
7.609-"))
7.610-
7.611- ;; labels
7.612- (is (string=
7.613- (vspark life-expectancies
7.614- :key #'second
7.615- :labels (mapcar #'first life-expectancies))
7.616- "
7.617- 56 66 76
7.618- ˫------------+-------------˧
7.619- Africa ▏
7.620- Americans ████████████████████████████
7.621- South-East Asia ███████████████▍
7.622- Europe ████████████████████████████
7.623-Eastern Mediterranean ████████████████▊
7.624- Western Pacific ████████████████████████████
7.625- Global ███████████████████▋
7.626-"))
7.627-
7.628- ;; title
7.629- (is (string=
7.630- (vspark life-expectancies
7.631- :min 50 :max 80
7.632- :key #'second
7.633- :labels (mapcar #'first life-expectancies)
7.634- :title "Life Expectancy")
7.635- "
7.636- Life Expectancy
7.637- 50 65 80
7.638- ˫------------+-------------˧
7.639- Africa █████▋
7.640- Americans ████████████████████████▎
7.641- South-East Asia ███████████████▉
7.642- Europe ████████████████████████▎
7.643-Eastern Mediterranean ████████████████▊
7.644- Western Pacific ████████████████████████▎
7.645- Global ██████████████████▋
7.646-"))
7.647-
7.648- (is (string=
7.649- (spark (range 0 15) :key #'fib)
7.650- "▁▁▁▁▁▁▁▁▁▁▂▂▃▅█"))
7.651-
7.652- (is (string=
7.653- (vspark (range 0 15) :key #'fib)
7.654- "
7.655-0 188.5 377
7.656-˫-----------------------+------------------------˧
7.657-▏
7.658-▏
7.659-▏
7.660-▎
7.661-▍
7.662-▋
7.663-█▏
7.664-█▊
7.665-██▊
7.666-████▌
7.667-███████▍
7.668-███████████▊
7.669-███████████████████▏
7.670-██████████████████████████████▉
7.671-██████████████████████████████████████████████████
7.672-")))))
7.673-
7.674-(deftest repl ())
7.675-
7.676-(deftest env ()
7.677- (is (ld-library-path-list))
7.678- (is (exec-path-list))
7.679- (is (find-exe "sbcl")))
7.680-
7.681-(deftest cli-ast ()
7.682- "Validate the CLI/CLAP/AST parser."
7.683- (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1"))))))
7.684- "foo"))
7.685- (signals clap-unknown-argument
7.686- (proc-args *cli* '("--log" "default" "--foo=11"))))
7.687-
7.688-(defmain foo-main (:exit nil)
7.689- (with-cli (*cli*) ()
7.690- (log:trace! "defmain is OK")
7.691- t))
7.692-
7.693-(deftest clap-main ()
7.694- (is (null (funcall #'foo-main))))
7.695-
7.696-(deftest sbcl-tools ()
7.697- (with-sbcl (:noinform t :quit t)
7.698- (print 1)))
8.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2+++ b/lisp/lib/cli/tests/clap.lisp Tue Oct 01 21:52:17 2024 -0400
8.3@@ -0,0 +1,71 @@
8.4+;;; clap.lisp --- CLAP tests
8.5+
8.6+;;
8.7+
8.8+;;; Code:
8.9+(in-package :cli/tests)
8.10+(in-suite :cli)
8.11+
8.12+(defcmd flub-thunk
8.13+ ;; FIX 2024-10-01:
8.14+ (println *optc*)
8.15+ (println *argc*)
8.16+ (print *opts*)
8.17+ (print *args*))
8.18+
8.19+(defparameter *opts* '((:name "foo" :description "bar" :kind string)
8.20+ (:name "bar" :description "foo" :kind string)))
8.21+(defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description"))
8.22+(defparameter *cmd2* (make-cli :cmd :name "ayo" :cmds (vector *cmd1*) :opts *opts* :description "cmd1 description"))
8.23+(defparameter *cmd3* (make-cli :cmd :name "flub" :opts *opts* :thunk 'flub-thunk))
8.24+(defparameter *cmds* (make-cmds (list `(:name "baz" :description "baz" :opts ,*opts*) *cmd1* *cmd2* *cmd3*)))
8.25+
8.26+(defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli"))
8.27+
8.28+(deftest mixed-args ()
8.29+ (with-cli (*cli*) '("--foo" "bar" "flub")
8.30+ (is (string= "bar" (cli-opt-val (aref (opts *cli*) 0))))
8.31+ (is (null (cli-args *cli*)))
8.32+ (do-cmd *cli*)))
8.33+
8.34+(deftest cli-ast ()
8.35+ "Validate the CLI/CLAP/AST parser."
8.36+ (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1"))))))
8.37+ "foo"))
8.38+ (signals clap-unknown-argument
8.39+ (proc-args *cli* '("--log" "default" "--foo=11"))))
8.40+
8.41+(defmain foo-main (:exit nil)
8.42+ (with-cli (*cli*) ()
8.43+ (log:trace! "defmain is OK")
8.44+ t))
8.45+
8.46+(deftest clap-main ()
8.47+ (is (null (funcall #'foo-main))))
8.48+
8.49+(deftest clap-basic (:skip t)
8.50+ "test basic CLAP functionality."
8.51+ (with-cli (*cli* opts cmds args) *args*
8.52+ (is (eq (make-shorty "test") #\t))
8.53+ (is (equalp (proc-args *cli* '("-f" "baz" "--bar=fax")) ;; not eql
8.54+ (make-cli-ast
8.55+ (list (make-cli-node 'opt (find-short-opts *cli* #\f))
8.56+ (make-cli-node 'cmd (find-cmd *cli* "baz"))
8.57+ (make-cli-node 'opt (find-opts *cli* "bar"))
8.58+ (make-cli-node 'arg "fax")))))
8.59+ (is (parse-args *cli* '("--bar" "baz" "-f" "yaks")))
8.60+ (is (stringp
8.61+ (with-output-to-string (s)
8.62+ (print-version *cli* s)
8.63+ (print-usage *cli* s)
8.64+ (print-help *cli* s))))
8.65+ (is (string= "foobar" (cli/clap:parse-string-opt "foobar")))
8.66+ (do-cmd *cli*)))
8.67+
8.68+(deftest clap-opts ()
8.69+ "CLAP opt tests."
8.70+ (make-opt-parser trivial *arg*)
8.71+ (is (reduce (lambda (x y) (and x y))
8.72+ (loop for k across *cli-opt-kinds* collect (cli-opt-kind-p k))))
8.73+ (is (parse-trivial-opt t))
8.74+ (is (null (parse-trivial-opt nil))))
9.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2+++ b/lisp/lib/cli/tests/pkg.lisp Tue Oct 01 21:52:17 2024 -0400
9.3@@ -0,0 +1,644 @@
9.4+;;; cli/tests.lisp --- CLI Tests
9.5+
9.6+;;
9.7+
9.8+;;; Code:
9.9+(defpackage :cli/tests
9.10+ (:use :cl :std :rt :cli :cli/shell :cli/progress :cli/spark :cli/repl :cli/ansi :cli/prompt :cli/clap :cli/tools/sbcl :dat/sxp))
9.11+
9.12+(in-package :cli/tests)
9.13+(declaim (optimize (debug 3) (safety 3)))
9.14+(defsuite :cli)
9.15+(in-suite :cli)
9.16+
9.17+(defun ansi-t01 ()
9.18+ (erase)
9.19+ (cursor-position 0 0)
9.20+ (princ "0")
9.21+ (cursor-position 2 2)
9.22+ (princ "1")
9.23+ (cursor-position 5 15)
9.24+ (princ "test")
9.25+ (cursor-position 10 15)
9.26+ (force-output)
9.27+ (with-input-from-string (in (format nil "test~%~%"))
9.28+ (let ((a (read-line in)))
9.29+ (cursor-position 12 15)
9.30+ (princ a)
9.31+ (force-output))))
9.32+
9.33+(defun ansi-t02 ()
9.34+ (print "normal")
9.35+ (.sgr 1)
9.36+ (print "bold")
9.37+ (.sgr 4)
9.38+ (print "bold underline")
9.39+ (.sgr 7)
9.40+ (print "bold underline reverse")
9.41+ (.sgr 22)
9.42+ (print "underline reverse")
9.43+ (.sgr 24)
9.44+ (print "reverse")
9.45+ (.sgr 27)
9.46+ (print "normal")
9.47+ (.sgr 1 4 7)
9.48+ (print "bold underline reverse")
9.49+ (.sgr 0)
9.50+ (print "normal")
9.51+ (force-output))
9.52+
9.53+(defun ansi-t03 ()
9.54+ "Display the 256 color palette."
9.55+ (clear)
9.56+ (loop for i from 0 to 255 do
9.57+ (.sgr 48 5 i)
9.58+ (princ #\space))
9.59+ (terpri)
9.60+ (.sgr 0)
9.61+ (loop for i from 0 to 255 do
9.62+ (.sgr 38 5 i)
9.63+ (princ "X"))
9.64+ (.sgr 0)
9.65+ (force-output)
9.66+ ;; (sleep 3)
9.67+ (.ris)
9.68+ (force-output))
9.69+
9.70+(defun ansi-t04 ()
9.71+ "Hide and show the cursor."
9.72+ (princ "Cursor visible:")
9.73+ (force-output)
9.74+ ;; (sleep 2)
9.75+ (terpri)
9.76+ (princ "Cursor invisible:")
9.77+ (hide-cursor)
9.78+ (force-output)
9.79+ ;; (sleep 2)
9.80+ (terpri)
9.81+ (princ "Cursor visible:")
9.82+ (show-cursor)
9.83+ (force-output)
9.84+ ;; (sleep 2)
9.85+ )
9.86+
9.87+(defun ansi-t05 ()
9.88+ "Switch to and back from the alternate screen buffer."
9.89+ (princ "Normal screen buffer. ")
9.90+ (force-output)
9.91+ ;; (sleep 2)
9.92+ (save-cursor-position)
9.93+ (use-alternate-screen-buffer)
9.94+ (clear)
9.95+ (princ "Alternate screen buffer.")
9.96+ (force-output)
9.97+ ;; (sleep 2)
9.98+ (use-normal-screen-buffer)
9.99+ (restore-cursor-position)
9.100+ (princ "Back to Normal screen buffer.")
9.101+ (force-output)
9.102+ ;; (sleep 1)
9.103+ )
9.104+
9.105+(defun ansi-t06 ()
9.106+ "Set individual termios flags to enable raw and disable echo mode.
9.107+
9.108+Enabling raw mode allows read-char to return immediately after a key is pressed.
9.109+
9.110+In the default cooked mode, the entry has to be confirmed by pressing enter."
9.111+ (set-tty-mode t :ignbrk nil
9.112+ :brkint nil
9.113+ :parmrk nil
9.114+ :istrip nil
9.115+ :inlcr nil
9.116+ :igncr nil
9.117+ :icrnl nil
9.118+ :ixon nil
9.119+ :opost nil
9.120+ :echo nil
9.121+ :echonl nil
9.122+ :icanon nil
9.123+ :isig nil
9.124+ :iexten nil
9.125+ :csize nil
9.126+ :parenb nil
9.127+ :vmin 1
9.128+ :vtime 0)
9.129+ (erase)
9.130+ (cursor-position 1 1)
9.131+ (force-output)
9.132+ (let ((a (read-char)))
9.133+ (cursor-position 10 5)
9.134+ (princ a)
9.135+ (force-output))
9.136+
9.137+ (set-tty-mode t :echo t
9.138+ :brkint t
9.139+ :ignpar t
9.140+ :istrip t
9.141+ :icrnl t
9.142+ :ixon t
9.143+ :opost t
9.144+ :isig t
9.145+ :icanon t
9.146+ :veol 0))
9.147+
9.148+(defun ansi-t07 ()
9.149+ "Use combination modes that consist of several individual flags.
9.150+
9.151+Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa."
9.152+ (set-tty-mode t :cooked nil)
9.153+ (erase)
9.154+ (cursor-position 1 1)
9.155+ (force-output)
9.156+ (let ((a (read-char)))
9.157+ (cursor-position 3 1)
9.158+ (princ a)
9.159+ (force-output))
9.160+ (set-tty-mode t :raw nil))
9.161+
9.162+(defun ansi-t08 ()
9.163+ "Why doesnt calling the stty utility work?"
9.164+ (uiop:run-program "stty raw -echo" :ignore-error-status t)
9.165+ (erase)
9.166+ (cursor-position 1 1)
9.167+ (force-output)
9.168+ (let ((a (read-char)))
9.169+ (cursor-position 2 1)
9.170+ (princ a)
9.171+ (force-output))
9.172+ (uiop:run-program "stty -raw echo" :ignore-error-status t))
9.173+
9.174+(defun ansi-t09 ()
9.175+ "Query terminal size with ANSI escape sequences."
9.176+ ;; Put the terminal into raw mode so we can read the "user input"
9.177+ ;; of the reply char by char
9.178+ ;; Turn off the echo or the sequence will be displayed
9.179+ (set-tty-mode t :cooked nil :echo nil)
9.180+ (save-cursor-position)
9.181+ ;; Go to the bottom right corner of the terminal by attempting
9.182+ ;; to go to some high value of row and column
9.183+ (cursor-position 999 999)
9.184+ (let (chars)
9.185+ ;; The terminal returns an escape sequence to the standard input
9.186+ (device-status-report)
9.187+ (force-output)
9.188+ ;; The reply isnt immediately available, the terminal does need
9.189+ ;; some time to answer
9.190+ (sleep 0.1)
9.191+ ;; The reply has to be read as if the user typed an escape sequence
9.192+ (loop for i = (read-char-no-hang *standard-input* nil)
9.193+ until (null i)
9.194+ do (push i chars))
9.195+ ;; Put the terminal back into its initial cooked state
9.196+ (set-tty-mode t :raw nil :echo t)
9.197+ (restore-cursor-position)
9.198+ ;; Return the read sequence as a list of characters.
9.199+ (nreverse chars)))
9.200+
9.201+(deftest ansi ()
9.202+ (with-input-from-string (in (format nil "~%~%"))
9.203+ (ansi-t01)
9.204+ (ansi-t02)
9.205+ (ansi-t03)
9.206+ (ansi-t04)
9.207+ (ansi-t05)))
9.208+
9.209+;; TODO: needs to be compiled outside scope of test - contender for
9.210+;; fixture API
9.211+(defprompt tpfoo :prompt "testing:")
9.212+
9.213+(deftest cli-prompt (:skip t)
9.214+ "Test CLI prompts"
9.215+ (defvar tcoll nil)
9.216+ (defvar thist nil)
9.217+ (let ((*standard-input* (make-string-input-stream
9.218+ (format nil "~A~%~A~%~%" "foobar" "foobar"))))
9.219+ ;; prompts
9.220+ (is (string= (tpfoo-prompt) "foobar"))
9.221+ (is (string= "foobar"
9.222+ (completing-read "nothing: " tcoll :history thist :default "foobar")))))
9.223+
9.224+(deftest progress ()
9.225+ (flet ((%step () (cli/progress::update 1)))
9.226+ (let ((*progress-bar-enabled* t)
9.227+ (n 100))
9.228+ (with-progress-bar (n "TEST: # of steps = ~a" n)
9.229+ (dotimes (i n) (%step))))))
9.230+
9.231+(deftest spark ()
9.232+ (is (string=
9.233+ (spark '(1 5 22 13 5))
9.234+ "▁▂█▅▂"))
9.235+ (is (string=
9.236+ (spark '(5.5 20))
9.237+ "▁█"))
9.238+ (is (string=
9.239+ (spark '(1 2 3 4 100 5 10 20 50 300))
9.240+ "▁▁▁▁▃▁▁▁▂█"))
9.241+ (is (string=
9.242+ (spark '(1 50 100))
9.243+ "▁▄█"))
9.244+ (is (string=
9.245+ (spark '(2 4 8))
9.246+ "▁▃█"))
9.247+ (is (string=
9.248+ (spark '(1 2 3 4 5))
9.249+ "▁▂▄▆█"))
9.250+ (is (string=
9.251+ (spark '(0 30 55 80 33 150))
9.252+ "▁▂▃▄▂█"))
9.253+ ;; null
9.254+ (is (string=
9.255+ (spark '())
9.256+ ""))
9.257+ ;; singleton
9.258+ (is (string=
9.259+ (spark '(42))
9.260+ "▁"))
9.261+ ;; constant
9.262+ (is (string=
9.263+ (spark '(42 42))
9.264+ "▁▁"))
9.265+ ;; min/max
9.266+ (is (string=
9.267+ (spark '(0 30 55 80 33 150) :min -100)
9.268+ "▃▄▅▆▄█"))
9.269+ (is (string=
9.270+ (spark '(0 30 55 80 33 150) :max 50)
9.271+ "▁▅██▅█"))
9.272+ (is (string=
9.273+ (spark '(0 30 55 80 33 150) :min 30 :max 80)
9.274+ "▁▁▄█▁█"))
9.275+ ;; double-float, minus
9.276+ (is (string=
9.277+ (spark '(1.000000000005d0 0.000000000005d0 1.0d0))
9.278+ "█▁▇"))
9.279+ (is (string=
9.280+ (spark '(-1 0 -1))
9.281+ "▁█▁"))
9.282+ (is (string=
9.283+ (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0))
9.284+ "▁█▁"))
9.285+ ;; *ticks*
9.286+ (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0)))
9.287+ (is (string=
9.288+ (spark ternary)
9.289+ "▁▄█▁█▄▄▁██▄"))
9.290+ (is (string=
9.291+ (let ((*ticks* #(#\_ #\- #\¯)))
9.292+ (spark ternary))
9.293+ "_-¯_¯--_¯¯-"))
9.294+ (is (string=
9.295+ (let ((*ticks* #(#\▄ #\⎯ #\▀)))
9.296+ (spark ternary))
9.297+ "▄⎯▀▄▀⎯⎯▄▀▀⎯"))
9.298+ (is (string=
9.299+ (let ((*ticks* #(#\E #\O)))
9.300+ (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2))))
9.301+ "EEOEE")))
9.302+ ;; key
9.303+ (flet ((range (start end) (loop for i from start below end collect i))
9.304+ (fib (n) (loop for x = 0 then y
9.305+ and y = 1 then (+ x y)
9.306+ repeat n
9.307+ finally (return x)))
9.308+ (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc)))))
9.309+ (rec n 1))))
9.310+ (is (string=
9.311+ (spark (range 0 51)
9.312+ :key (lambda (x) (sin (* x pi 1/4))))
9.313+ "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█"))
9.314+ (is (string=
9.315+ (spark (range 0 51)
9.316+ :key (lambda (x) (cos (* x pi 1/4))))
9.317+ "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄"))
9.318+
9.319+ (is (string=
9.320+ (spark (range 0 51)
9.321+ :key (lambda (x) (abs (cis (* x pi 1/4)))))
9.322+ "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁"))
9.323+
9.324+ (is (string=
9.325+ (spark (range 0 51)
9.326+ :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0)))
9.327+ "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆"))
9.328+
9.329+ (is (string=
9.330+ (spark (range 1 7) :key #'log)
9.331+ "▁▃▅▆▇█"))
9.332+
9.333+ (is (string=
9.334+ (spark (range 1 7) :key #'sqrt)
9.335+ "▁▃▄▅▆█"))
9.336+ (is (string=
9.337+ (spark (range 1 7))
9.338+ "▁▂▃▅▆█"))
9.339+ (is (string=
9.340+ (spark (range 1 7) :key #'fib)
9.341+ "▁▁▂▃▅█"))
9.342+ (is (string=
9.343+ (spark (range 1 7) :key #'exp)
9.344+ "▁▁▁▁▃█"))
9.345+ (is (string=
9.346+ (spark (range 1 7) :key #'fac)
9.347+ "▁▁▁▁▂█"))
9.348+ (is (string=
9.349+ (spark (range 1 7) :key #'isqrt)
9.350+ "▁▁▁███"))
9.351+ ;; misc
9.352+ (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2)))))
9.353+ (is (string=
9.354+ (lbits 42)
9.355+ "█▁█▁█▁"))
9.356+ (is (string=
9.357+ (lbits 43)
9.358+ "█▁█▁██"))
9.359+ (is (string=
9.360+ (lbits 44)
9.361+ "█▁██▁▁"))
9.362+ (is (string=
9.363+ (lbits 45)
9.364+ "█▁██▁█")))
9.365+
9.366+ ;; VSPARK
9.367+ (is (string=
9.368+ (vspark '())
9.369+ ""))
9.370+ ;; singleton
9.371+ (is (string=
9.372+ (vspark '(1))
9.373+ "
9.374+1 1.5 2
9.375+˫-----------------------+------------------------˧
9.376+▏
9.377+"))
9.378+
9.379+ ;; constant
9.380+ (is (string=
9.381+ (vspark '(1 1))
9.382+ "
9.383+1 1.5 2
9.384+˫-----------------------+------------------------˧
9.385+▏
9.386+▏
9.387+"))
9.388+
9.389+
9.390+ (is (string=
9.391+ (vspark '(0 30 55 80 33 150))
9.392+ "
9.393+0 75 150
9.394+˫-----------------------+------------------------˧
9.395+▏
9.396+██████████▏
9.397+██████████████████▍
9.398+██████████████████████████▋
9.399+███████████▏
9.400+██████████████████████████████████████████████████
9.401+"))
9.402+
9.403+
9.404+ ;; min, max
9.405+
9.406+ (is (string=
9.407+ (vspark '(0 30 55 80 33 150) :min -100)
9.408+ "
9.409+-100 25 150
9.410+˫-----------------------+------------------------˧
9.411+████████████████████▏
9.412+██████████████████████████▏
9.413+███████████████████████████████▏
9.414+████████████████████████████████████▏
9.415+██████████████████████████▋
9.416+██████████████████████████████████████████████████
9.417+"))
9.418+
9.419+ (is (string=
9.420+ (vspark '(0 30 55 80 33 150) :max 50)
9.421+ "
9.422+0 25 50
9.423+˫-----------------------+------------------------˧
9.424+▏
9.425+██████████████████████████████▏
9.426+██████████████████████████████████████████████████
9.427+██████████████████████████████████████████████████
9.428+█████████████████████████████████▏
9.429+██████████████████████████████████████████████████
9.430+"))
9.431+
9.432+
9.433+ (is (string=
9.434+ (vspark '(0 30 55 80 33 150) :min 30 :max 80)
9.435+ "
9.436+30 55 80
9.437+˫-----------------------+------------------------˧
9.438+▏
9.439+▏
9.440+█████████████████████████▏
9.441+██████████████████████████████████████████████████
9.442+███▏
9.443+██████████████████████████████████████████████████
9.444+"))
9.445+
9.446+ ;; labels
9.447+ (is (string=
9.448+ (vspark '(1 0 .5) :labels '("on" "off" "unknown")
9.449+ :size 1
9.450+ :scale? nil)
9.451+ "
9.452+ on █
9.453+ off ▏
9.454+unknown ▌
9.455+"))
9.456+
9.457+ (is (string=
9.458+ (vspark '(1 0 .5) :labels '("on" "off")
9.459+ :size 1
9.460+ :scale? nil)
9.461+ "
9.462+ on █
9.463+off ▏
9.464+ ▌
9.465+"))
9.466+
9.467+ (is (string=
9.468+ (vspark '(1 0) :labels '("on" "off" "unknown")
9.469+ :size 1
9.470+ :scale? nil)
9.471+ "
9.472+ on █
9.473+off ▏
9.474+"))
9.475+
9.476+ ;; key
9.477+ (is (string=
9.478+ (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))))
9.479+ "
9.480+-1.0 0.0 1.0
9.481+˫-----------------------+------------------------˧
9.482+█████████████████████████▏
9.483+██████████████████████████████████████████▋
9.484+██████████████████████████████████████████████████
9.485+██████████████████████████████████████████▋
9.486+█████████████████████████▏
9.487+███████▍
9.488+▏
9.489+███████▍
9.490+████████████████████████▉
9.491+"))
9.492+
9.493+ ;; size
9.494+ (is (string=
9.495+ (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
9.496+ :size 10)
9.497+ "
9.498+-1.0 1.0
9.499+˫--------˧
9.500+█████▏
9.501+████████▌
9.502+██████████
9.503+████████▌
9.504+█████▏
9.505+█▌
9.506+▏
9.507+█▌
9.508+████▉
9.509+"))
9.510+
9.511+ ;; scale (mid-point)
9.512+ (is (string=
9.513+ (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
9.514+ :size 20)
9.515+ "
9.516+-1.0 0.0 1.0
9.517+˫--------+---------˧
9.518+██████████▏
9.519+█████████████████▏
9.520+████████████████████
9.521+█████████████████▏
9.522+██████████▏
9.523+██▉
9.524+▏
9.525+██▉
9.526+█████████▉
9.527+"))
9.528+
9.529+ (let ((life-expectancies '(("Africa" 56)
9.530+ ("Americans" 76)
9.531+ ("South-East Asia" 67)
9.532+ ("Europe" 76)
9.533+ ("Eastern Mediterranean" 68)
9.534+ ("Western Pacific" 76)
9.535+ ("Global" 70))))
9.536+
9.537+ (is (string=
9.538+ (vspark life-expectancies :key #'second)
9.539+ "
9.540+56 66 76
9.541+˫-----------------------+------------------------˧
9.542+▏
9.543+██████████████████████████████████████████████████
9.544+███████████████████████████▌
9.545+██████████████████████████████████████████████████
9.546+██████████████████████████████▏
9.547+██████████████████████████████████████████████████
9.548+███████████████████████████████████▏
9.549+"))
9.550+
9.551+ ;; newline?
9.552+ (is (string=
9.553+ (vspark life-expectancies :key #'second :scale? nil :newline? nil)
9.554+ "▏
9.555+██████████████████████████████████████████████████
9.556+███████████████████████████▌
9.557+██████████████████████████████████████████████████
9.558+██████████████████████████████▏
9.559+██████████████████████████████████████████████████
9.560+███████████████████████████████████▏"))
9.561+
9.562+ ;; scale?
9.563+ (is (string=
9.564+ (vspark life-expectancies :key #'second :scale? nil)
9.565+ "
9.566+▏
9.567+██████████████████████████████████████████████████
9.568+███████████████████████████▌
9.569+██████████████████████████████████████████████████
9.570+██████████████████████████████▏
9.571+██████████████████████████████████████████████████
9.572+███████████████████████████████████▏
9.573+"))
9.574+
9.575+ ;; labels
9.576+ (is (string=
9.577+ (vspark life-expectancies
9.578+ :key #'second
9.579+ :labels (mapcar #'first life-expectancies))
9.580+ "
9.581+ 56 66 76
9.582+ ˫------------+-------------˧
9.583+ Africa ▏
9.584+ Americans ████████████████████████████
9.585+ South-East Asia ███████████████▍
9.586+ Europe ████████████████████████████
9.587+Eastern Mediterranean ████████████████▊
9.588+ Western Pacific ████████████████████████████
9.589+ Global ███████████████████▋
9.590+"))
9.591+
9.592+ ;; title
9.593+ (is (string=
9.594+ (vspark life-expectancies
9.595+ :min 50 :max 80
9.596+ :key #'second
9.597+ :labels (mapcar #'first life-expectancies)
9.598+ :title "Life Expectancy")
9.599+ "
9.600+ Life Expectancy
9.601+ 50 65 80
9.602+ ˫------------+-------------˧
9.603+ Africa █████▋
9.604+ Americans ████████████████████████▎
9.605+ South-East Asia ███████████████▉
9.606+ Europe ████████████████████████▎
9.607+Eastern Mediterranean ████████████████▊
9.608+ Western Pacific ████████████████████████▎
9.609+ Global ██████████████████▋
9.610+"))
9.611+
9.612+ (is (string=
9.613+ (spark (range 0 15) :key #'fib)
9.614+ "▁▁▁▁▁▁▁▁▁▁▂▂▃▅█"))
9.615+
9.616+ (is (string=
9.617+ (vspark (range 0 15) :key #'fib)
9.618+ "
9.619+0 188.5 377
9.620+˫-----------------------+------------------------˧
9.621+▏
9.622+▏
9.623+▏
9.624+▎
9.625+▍
9.626+▋
9.627+█▏
9.628+█▊
9.629+██▊
9.630+████▌
9.631+███████▍
9.632+███████████▊
9.633+███████████████████▏
9.634+██████████████████████████████▉
9.635+██████████████████████████████████████████████████
9.636+")))))
9.637+
9.638+(deftest repl ())
9.639+
9.640+(deftest env ()
9.641+ (ld-library-path-list)
9.642+ (is (exec-path-list))
9.643+ (is (find-exe "sbcl")))
9.644+
9.645+(deftest sbcl-tools ()
9.646+ (with-sbcl (:noinform t :quit t)
9.647+ (print 1)))
