Mercurial > core / lisp/lib/cli/tests.lisp
changeset 644: |
f59072409c7a |
parent: |
f901de70a80e
|
child: |
3e6a17fb5712 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Tue, 10 Sep 2024 21:52:14 -0400 |
permissions: |
-rw-r--r-- |
description: |
revert cli-cmds back to list instead of &rest |
1 ;;; cli/tests.lisp --- CLI Tests 7 (: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 (in-package :cli/tests) 10 (declaim (optimize (debug 3) (safety 3))) 20 (cursor-position 5 15) 22 (cursor-position 10 15) 24 (with-input-from-string (in (format nil "test~%~%")) 25 (let ((a (read-line in))) 26 (cursor-position 12 15) 35 (print "bold underline") 37 (print "bold underline reverse") 39 (print "underline reverse") 45 (print "bold underline reverse") 51 "Display the 256 color palette." 53 (loop for i from 0 to 255 do 58 (loop for i from 0 to 255 do 68 "Hide and show the cursor." 69 (princ "Cursor visible:") 73 (princ "Cursor invisible:") 78 (princ "Cursor visible:") 85 "Switch to and back from the alternate screen buffer." 86 (princ "Normal screen buffer. ") 89 (save-cursor-position) 90 (use-alternate-screen-buffer) 92 (princ "Alternate screen buffer.") 95 (use-normal-screen-buffer) 96 (restore-cursor-position) 97 (princ "Back to Normal screen buffer.") 103 "Set individual termios flags to enable raw and disable echo mode. 105 Enabling raw mode allows read-char to return immediately after a key is pressed. 107 In the default cooked mode, the entry has to be confirmed by pressing enter." 108 (set-tty-mode t :ignbrk nil 127 (cursor-position 1 1) 129 (let ((a (read-char))) 130 (cursor-position 10 5) 134 (set-tty-mode t :echo t 146 "Use combination modes that consist of several individual flags. 148 Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa." 149 (set-tty-mode t :cooked nil) 151 (cursor-position 1 1) 153 (let ((a (read-char))) 154 (cursor-position 3 1) 157 (set-tty-mode t :raw nil)) 160 "Why doesnt calling the stty utility work?" 161 (uiop:run-program "stty raw -echo" :ignore-error-status t) 163 (cursor-position 1 1) 165 (let ((a (read-char))) 166 (cursor-position 2 1) 169 (uiop:run-program "stty -raw echo" :ignore-error-status t)) 172 "Query terminal size with ANSI escape sequences." 173 ;; Put the terminal into raw mode so we can read the "user input" 174 ;; of the reply char by char 175 ;; Turn off the echo or the sequence will be displayed 176 (set-tty-mode t :cooked nil :echo nil) 177 (save-cursor-position) 178 ;; Go to the bottom right corner of the terminal by attempting 179 ;; to go to some high value of row and column 180 (cursor-position 999 999) 182 ;; The terminal returns an escape sequence to the standard input 183 (device-status-report) 185 ;; The reply isnt immediately available, the terminal does need 186 ;; some time to answer 188 ;; The reply has to be read as if the user typed an escape sequence 189 (loop for i = (read-char-no-hang *standard-input* nil) 192 ;; Put the terminal back into its initial cooked state 193 (set-tty-mode t :raw nil :echo t) 194 (restore-cursor-position) 195 ;; Return the read sequence as a list of characters. 199 (with-input-from-string (in (format nil "~%~%")) 206 ;; TODO: needs to be compiled outside scope of test - contender for 208 (defprompt tpfoo :prompt "testing:") 210 (deftest cli-prompt (:skip t) 214 (let ((*standard-input* (make-string-input-stream 215 (format nil "~A~%~A~%~%" "foobar" "foobar")))) 217 (is (string= (tpfoo-prompt) "foobar")) 218 (is (string= "foobar" 219 (completing-read "nothing: " tcoll :history thist :default "foobar"))))) 221 (defparameter *opts* '((:name "foo" :global t :description "bar") 222 (:name "bar" :description "foo"))) 224 (defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description")) 225 (defparameter *cmd2* (make-cli :cmd :name "ayo" :cmds (vector *cmd1*) :opts *opts* :description "cmd1 description")) 226 (defparameter *cmds* (make-cmds (list `(:name "baz" :description "baz" :opts ,*opts*) *cmd1* *cmd2*))) 228 (defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli")) 231 (deftest clap-basic () 232 "test basic CLAP functionality." 234 (is (eq (make-shorty "test") #\t)) 235 (is (equalp (proc-args cli '("-f" "baz" "--bar=fax")) ;; not eql 237 (list (make-cli-node 'opt (find-short-opts cli #\f)) 238 (make-cli-node 'cmd (find-cmd cli "baz")) 239 (make-cli-node 'opt (find-opts cli "bar")) 240 (make-cli-node 'arg "fax"))))) 241 (is (parse-args cli '("--bar" "baz" "-f" "yaks"))) 243 (with-output-to-string (s) 244 (print-version cli s) 246 (print-help cli s)))) 247 (is (string= "foobar" (cli/clap:parse-string-opt "foobar"))))) 249 (make-opt-parser thing *arg*) 251 (deftest clap-opts () 253 (is (reduce (lambda (x y) (and x y)) 254 (loop for k across *cli-opt-kinds* collect (cli-opt-kind-p k)))) 255 (is (parse-thing-opt t)) 256 (is (null (parse-thing-opt nil)))) 259 (flet ((%step () (cli/progress::update 1))) 260 (let ((*progress-bar-enabled* t) 262 (with-progress-bar (n "TEST: # of steps = ~a" n) 263 (dotimes (i n) (%step)))))) 267 (spark '(1 5 22 13 5)) 273 (spark '(1 2 3 4 100 5 10 20 50 300)) 285 (spark '(0 30 55 80 33 150)) 301 (spark '(0 30 55 80 33 150) :min -100) 304 (spark '(0 30 55 80 33 150) :max 50) 307 (spark '(0 30 55 80 33 150) :min 30 :max 80) 309 ;; double-float, minus 311 (spark '(1.000000000005d0 0.000000000005d0 1.0d0)) 317 (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0)) 320 (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0))) 325 (let ((*ticks* #(#\_ #\- #\¯))) 329 (let ((*ticks* #(#\▄ #\⎯ #\▀))) 333 (let ((*ticks* #(#\E #\O))) 334 (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2)))) 337 (flet ((range (start end) (loop for i from start below end collect i)) 338 (fib (n) (loop for x = 0 then y 339 and y = 1 then (+ x y) 342 (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc))))) 346 :key (lambda (x) (sin (* x pi 1/4)))) 347 "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█")) 350 :key (lambda (x) (cos (* x pi 1/4)))) 351 "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄")) 355 :key (lambda (x) (abs (cis (* x pi 1/4))))) 356 "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁")) 360 :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0))) 361 "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆")) 364 (spark (range 1 7) :key #'log) 368 (spark (range 1 7) :key #'sqrt) 374 (spark (range 1 7) :key #'fib) 377 (spark (range 1 7) :key #'exp) 380 (spark (range 1 7) :key #'fac) 383 (spark (range 1 7) :key #'isqrt) 386 (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2))))) 409 ˫-----------------------+------------------------˧ 418 ˫-----------------------+------------------------˧ 425 (vspark '(0 30 55 80 33 150)) 428 ˫-----------------------+------------------------˧ 432 ██████████████████████████▋ 434 ██████████████████████████████████████████████████ 441 (vspark '(0 30 55 80 33 150) :min -100) 444 ˫-----------------------+------------------------˧ 445 ████████████████████▏ 446 ██████████████████████████▏ 447 ███████████████████████████████▏ 448 ████████████████████████████████████▏ 449 ██████████████████████████▋ 450 ██████████████████████████████████████████████████ 454 (vspark '(0 30 55 80 33 150) :max 50) 457 ˫-----------------------+------------------------˧ 459 ██████████████████████████████▏ 460 ██████████████████████████████████████████████████ 461 ██████████████████████████████████████████████████ 462 █████████████████████████████████▏ 463 ██████████████████████████████████████████████████ 468 (vspark '(0 30 55 80 33 150) :min 30 :max 80) 471 ˫-----------------------+------------------------˧ 474 █████████████████████████▏ 475 ██████████████████████████████████████████████████ 477 ██████████████████████████████████████████████████ 482 (vspark '(1 0 .5) :labels '("on" "off" "unknown") 492 (vspark '(1 0 .5) :labels '("on" "off") 502 (vspark '(1 0) :labels '("on" "off" "unknown") 512 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))) 515 ˫-----------------------+------------------------˧ 516 █████████████████████████▏ 517 ██████████████████████████████████████████▋ 518 ██████████████████████████████████████████████████ 519 ██████████████████████████████████████████▋ 520 █████████████████████████▏ 524 ████████████████████████▉ 529 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 547 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 563 (let ((life-expectancies '(("Africa" 56) 565 ("South-East Asia" 67) 567 ("Eastern Mediterranean" 68) 568 ("Western Pacific" 76) 572 (vspark life-expectancies :key #'second) 575 ˫-----------------------+------------------------˧ 577 ██████████████████████████████████████████████████ 578 ███████████████████████████▌ 579 ██████████████████████████████████████████████████ 580 ██████████████████████████████▏ 581 ██████████████████████████████████████████████████ 582 ███████████████████████████████████▏ 587 (vspark life-expectancies :key #'second :scale? nil :newline? nil) 589 ██████████████████████████████████████████████████ 590 ███████████████████████████▌ 591 ██████████████████████████████████████████████████ 592 ██████████████████████████████▏ 593 ██████████████████████████████████████████████████ 594 ███████████████████████████████████▏")) 598 (vspark life-expectancies :key #'second :scale? nil) 601 ██████████████████████████████████████████████████ 602 ███████████████████████████▌ 603 ██████████████████████████████████████████████████ 604 ██████████████████████████████▏ 605 ██████████████████████████████████████████████████ 606 ███████████████████████████████████▏ 611 (vspark life-expectancies 613 :labels (mapcar #'first life-expectancies)) 616 ˫------------+-------------˧ 618 Americans ████████████████████████████ 619 South-East Asia ███████████████▍ 620 Europe ████████████████████████████ 621 Eastern Mediterranean ████████████████▊ 622 Western Pacific ████████████████████████████ 623 Global ███████████████████▋ 628 (vspark life-expectancies 631 :labels (mapcar #'first life-expectancies) 632 :title "Life Expectancy") 636 ˫------------+-------------˧ 638 Americans ████████████████████████▎ 639 South-East Asia ███████████████▉ 640 Europe ████████████████████████▎ 641 Eastern Mediterranean ████████████████▊ 642 Western Pacific ████████████████████████▎ 643 Global ██████████████████▋ 647 (spark (range 0 15) :key #'fib) 651 (vspark (range 0 15) :key #'fib) 654 ˫-----------------------+------------------------˧ 668 ██████████████████████████████▉ 669 ██████████████████████████████████████████████████ 675 (is (ld-library-path-list)) 676 (is (exec-path-list)) 677 (is (find-exe "sbcl"))) 680 "Validate the CLI/CLAP/AST parser." 682 (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1")))))) 685 (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo=11")))))) 688 (defmain (:exit nil :export nil) 690 (log:trace! "defmain is OK") 693 (deftest clap-main () 694 (is (null (funcall #'main)))) 696 (deftest sbcl-tools () 697 (with-sbcl (:noinform t :quit t)