Mercurial > core / lisp/lib/cli/tests.lisp
changeset 645: |
3e6a17fb5712 |
parent: |
f59072409c7a
|
child: |
74e563ed4537 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Wed, 11 Sep 2024 17:24:07 -0400 |
permissions: |
-rw-r--r-- |
description: |
clap upgrades |
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" :kind string))) 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 (:skip t) 232 "test basic CLAP functionality." 233 (is (eq (make-shorty "test") #\t)) 234 (is (equalp (proc-args *cli* '("-f" "baz" "--bar=fax")) ;; not eql 236 (list (make-cli-node 'opt (find-short-opts cli #\f)) 237 (make-cli-node 'cmd (find-cmd cli "baz")) 238 (make-cli-node 'opt (find-opts cli "bar")) 239 (make-cli-node 'arg "fax"))))) 240 (is (parse-args cli '("--bar" "baz" "-f" "yaks"))) 242 (with-output-to-string (s) 243 (print-version *cli* s) 244 (print-usage *cli* s) 245 (print-help *cli* s)))) 246 (is (string= "foobar" (cli/clap:parse-string-opt "foobar")))) 248 (make-opt-parser thing *arg*) 250 (deftest clap-opts () 252 (is (reduce (lambda (x y) (and x y)) 253 (loop for k across *cli-opt-kinds* collect (cli-opt-kind-p k)))) 254 (is (parse-thing-opt t)) 255 (is (null (parse-thing-opt nil)))) 258 (flet ((%step () (cli/progress::update 1))) 259 (let ((*progress-bar-enabled* t) 261 (with-progress-bar (n "TEST: # of steps = ~a" n) 262 (dotimes (i n) (%step)))))) 266 (spark '(1 5 22 13 5)) 272 (spark '(1 2 3 4 100 5 10 20 50 300)) 284 (spark '(0 30 55 80 33 150)) 300 (spark '(0 30 55 80 33 150) :min -100) 303 (spark '(0 30 55 80 33 150) :max 50) 306 (spark '(0 30 55 80 33 150) :min 30 :max 80) 308 ;; double-float, minus 310 (spark '(1.000000000005d0 0.000000000005d0 1.0d0)) 316 (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0)) 319 (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0))) 324 (let ((*ticks* #(#\_ #\- #\¯))) 328 (let ((*ticks* #(#\▄ #\⎯ #\▀))) 332 (let ((*ticks* #(#\E #\O))) 333 (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2)))) 336 (flet ((range (start end) (loop for i from start below end collect i)) 337 (fib (n) (loop for x = 0 then y 338 and y = 1 then (+ x y) 341 (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc))))) 345 :key (lambda (x) (sin (* x pi 1/4)))) 346 "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█")) 349 :key (lambda (x) (cos (* x pi 1/4)))) 350 "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄")) 354 :key (lambda (x) (abs (cis (* x pi 1/4))))) 355 "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁")) 359 :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0))) 360 "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆")) 363 (spark (range 1 7) :key #'log) 367 (spark (range 1 7) :key #'sqrt) 373 (spark (range 1 7) :key #'fib) 376 (spark (range 1 7) :key #'exp) 379 (spark (range 1 7) :key #'fac) 382 (spark (range 1 7) :key #'isqrt) 385 (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2))))) 408 ˫-----------------------+------------------------˧ 417 ˫-----------------------+------------------------˧ 424 (vspark '(0 30 55 80 33 150)) 427 ˫-----------------------+------------------------˧ 431 ██████████████████████████▋ 433 ██████████████████████████████████████████████████ 440 (vspark '(0 30 55 80 33 150) :min -100) 443 ˫-----------------------+------------------------˧ 444 ████████████████████▏ 445 ██████████████████████████▏ 446 ███████████████████████████████▏ 447 ████████████████████████████████████▏ 448 ██████████████████████████▋ 449 ██████████████████████████████████████████████████ 453 (vspark '(0 30 55 80 33 150) :max 50) 456 ˫-----------------------+------------------------˧ 458 ██████████████████████████████▏ 459 ██████████████████████████████████████████████████ 460 ██████████████████████████████████████████████████ 461 █████████████████████████████████▏ 462 ██████████████████████████████████████████████████ 467 (vspark '(0 30 55 80 33 150) :min 30 :max 80) 470 ˫-----------------------+------------------------˧ 473 █████████████████████████▏ 474 ██████████████████████████████████████████████████ 476 ██████████████████████████████████████████████████ 481 (vspark '(1 0 .5) :labels '("on" "off" "unknown") 491 (vspark '(1 0 .5) :labels '("on" "off") 501 (vspark '(1 0) :labels '("on" "off" "unknown") 511 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))) 514 ˫-----------------------+------------------------˧ 515 █████████████████████████▏ 516 ██████████████████████████████████████████▋ 517 ██████████████████████████████████████████████████ 518 ██████████████████████████████████████████▋ 519 █████████████████████████▏ 523 ████████████████████████▉ 528 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 546 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 562 (let ((life-expectancies '(("Africa" 56) 564 ("South-East Asia" 67) 566 ("Eastern Mediterranean" 68) 567 ("Western Pacific" 76) 571 (vspark life-expectancies :key #'second) 574 ˫-----------------------+------------------------˧ 576 ██████████████████████████████████████████████████ 577 ███████████████████████████▌ 578 ██████████████████████████████████████████████████ 579 ██████████████████████████████▏ 580 ██████████████████████████████████████████████████ 581 ███████████████████████████████████▏ 586 (vspark life-expectancies :key #'second :scale? nil :newline? nil) 588 ██████████████████████████████████████████████████ 589 ███████████████████████████▌ 590 ██████████████████████████████████████████████████ 591 ██████████████████████████████▏ 592 ██████████████████████████████████████████████████ 593 ███████████████████████████████████▏")) 597 (vspark life-expectancies :key #'second :scale? nil) 600 ██████████████████████████████████████████████████ 601 ███████████████████████████▌ 602 ██████████████████████████████████████████████████ 603 ██████████████████████████████▏ 604 ██████████████████████████████████████████████████ 605 ███████████████████████████████████▏ 610 (vspark life-expectancies 612 :labels (mapcar #'first life-expectancies)) 615 ˫------------+-------------˧ 617 Americans ████████████████████████████ 618 South-East Asia ███████████████▍ 619 Europe ████████████████████████████ 620 Eastern Mediterranean ████████████████▊ 621 Western Pacific ████████████████████████████ 622 Global ███████████████████▋ 627 (vspark life-expectancies 630 :labels (mapcar #'first life-expectancies) 631 :title "Life Expectancy") 635 ˫------------+-------------˧ 637 Americans ████████████████████████▎ 638 South-East Asia ███████████████▉ 639 Europe ████████████████████████▎ 640 Eastern Mediterranean ████████████████▊ 641 Western Pacific ████████████████████████▎ 642 Global ██████████████████▋ 646 (spark (range 0 15) :key #'fib) 650 (vspark (range 0 15) :key #'fib) 653 ˫-----------------------+------------------------˧ 667 ██████████████████████████████▉ 668 ██████████████████████████████████████████████████ 674 (is (ld-library-path-list)) 675 (is (exec-path-list)) 676 (is (find-exe "sbcl"))) 679 "Validate the CLI/CLAP/AST parser." 680 (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1")))))) 682 (signals clap-unknown-argument 683 (proc-args *cli* '("--log" "default" "--foo=11")))) 685 (defmain (:exit nil :export nil) 687 (log:trace! "defmain is OK") 690 (deftest clap-main () 691 (let ((sb-ext:*posix-argv* nil)) 692 (is (null (funcall #'main))))) 694 (deftest sbcl-tools () 695 (with-sbcl (:noinform t :quit t)