changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/cli/tests.lisp

changeset 643: f901de70a80e
parent: cc13027df6fa
child: f59072409c7a
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 10 Sep 2024 21:26:30 -0400
permissions: -rw-r--r--
description: opt fixes and test updates 
     1 ;;; cli/tests.lisp --- CLI Tests
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (defpackage :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))
     8 
     9 (in-package :cli/tests)
    10 (declaim (optimize (debug 3) (safety 3)))
    11 (defsuite :cli)
    12 (in-suite :cli)
    13 
    14 (defun ansi-t01 ()
    15   (erase)
    16     (cursor-position 0 0)
    17     (princ "0")
    18     (cursor-position 2 2)
    19     (princ "1")
    20     (cursor-position 5 15)
    21     (princ "test")
    22     (cursor-position 10 15)
    23     (force-output)
    24   (with-input-from-string (in (format nil "test~%~%"))
    25     (let ((a (read-line in)))
    26       (cursor-position 12 15)
    27       (princ a)
    28       (force-output))))
    29 
    30 (defun ansi-t02 ()
    31   (print "normal")
    32   (.sgr 1)
    33   (print "bold")
    34   (.sgr 4)
    35   (print "bold underline")
    36   (.sgr 7)
    37   (print "bold underline reverse")
    38   (.sgr 22)
    39   (print "underline reverse")
    40   (.sgr 24)
    41   (print "reverse")
    42   (.sgr 27)
    43   (print "normal")
    44   (.sgr 1 4 7)
    45   (print "bold underline reverse")
    46   (.sgr 0)
    47   (print "normal")
    48   (force-output))
    49 
    50 (defun ansi-t03 ()
    51   "Display the 256 color palette."
    52   (clear)
    53   (loop for i from 0 to 255 do
    54            (.sgr 48 5 i)
    55            (princ #\space))
    56   (terpri)
    57   (.sgr 0)
    58   (loop for i from 0 to 255 do
    59            (.sgr 38 5 i)
    60            (princ "X"))
    61   (.sgr 0)
    62   (force-output)
    63   ;; (sleep 3)
    64   (.ris)
    65   (force-output))
    66 
    67 (defun ansi-t04 ()
    68   "Hide and show the cursor."
    69   (princ "Cursor visible:")
    70   (force-output)
    71   ;; (sleep 2)
    72   (terpri)
    73   (princ "Cursor invisible:")
    74   (hide-cursor)
    75   (force-output)
    76   ;; (sleep 2)
    77   (terpri)
    78   (princ "Cursor visible:")
    79   (show-cursor)
    80   (force-output)
    81   ;; (sleep 2)
    82   )
    83 
    84 (defun ansi-t05 ()
    85   "Switch to and back from the alternate screen buffer."
    86   (princ "Normal screen buffer. ")
    87   (force-output)
    88   ;; (sleep 2)
    89   (save-cursor-position)
    90   (use-alternate-screen-buffer)
    91   (clear)
    92   (princ "Alternate screen buffer.")
    93   (force-output)
    94   ;; (sleep 2)
    95   (use-normal-screen-buffer)
    96   (restore-cursor-position)
    97   (princ "Back to Normal screen buffer.")
    98   (force-output)
    99   ;; (sleep 1)
   100   )
   101 
   102 (defun ansi-t06 ()
   103   "Set individual termios flags to enable raw and disable echo mode.
   104 
   105 Enabling raw mode allows read-char to return immediately after a key is pressed.
   106 
   107 In the default cooked mode, the entry has to be confirmed by pressing enter."
   108   (set-tty-mode t :ignbrk nil
   109                   :brkint nil
   110                   :parmrk nil
   111                   :istrip nil
   112                   :inlcr  nil
   113                   :igncr  nil
   114                   :icrnl  nil
   115                   :ixon   nil
   116                   :opost  nil
   117                   :echo   nil
   118                   :echonl nil
   119                   :icanon nil
   120                   :isig   nil
   121                   :iexten nil
   122                   :csize  nil
   123                   :parenb nil
   124                   :vmin 1
   125                   :vtime 0)
   126   (erase)
   127   (cursor-position 1 1)
   128   (force-output)
   129   (let ((a (read-char)))
   130     (cursor-position 10 5)
   131     (princ a)
   132     (force-output))
   133 
   134   (set-tty-mode t :echo t
   135                   :brkint t
   136                   :ignpar t
   137                   :istrip t
   138                   :icrnl t
   139                   :ixon t
   140                   :opost t
   141                   :isig t
   142                   :icanon t
   143                   :veol 0))
   144 
   145 (defun ansi-t07 ()
   146   "Use combination modes that consist of several individual flags.
   147 
   148 Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa."
   149   (set-tty-mode t :cooked nil)
   150   (erase)
   151   (cursor-position 1 1)
   152   (force-output)
   153   (let ((a (read-char)))
   154     (cursor-position 3 1)
   155     (princ a)
   156     (force-output))
   157   (set-tty-mode t :raw nil))
   158 
   159 (defun ansi-t08 ()
   160   "Why doesnt calling the stty utility work?"
   161   (uiop:run-program "stty raw -echo" :ignore-error-status t)
   162   (erase)
   163   (cursor-position 1 1)
   164   (force-output)
   165   (let ((a (read-char)))
   166     (cursor-position 2 1)
   167     (princ a)
   168     (force-output))
   169   (uiop:run-program "stty -raw echo" :ignore-error-status t))
   170 
   171 (defun ansi-t09 ()
   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)
   181   (let (chars)
   182     ;; The terminal returns an escape sequence to the standard input
   183     (device-status-report)
   184     (force-output)
   185     ;; The reply isnt immediately available, the terminal does need
   186     ;; some time to answer
   187     (sleep 0.1)
   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)
   190           until (null i)
   191           do (push i chars))
   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.
   196     (nreverse chars)))
   197 
   198 (deftest ansi ()
   199   (with-input-from-string (in (format nil "~%~%"))
   200     (ansi-t01)
   201     (ansi-t02)
   202     (ansi-t03)
   203     (ansi-t04)
   204     (ansi-t05)))
   205 
   206 ;; TODO: needs to be compiled outside scope of test - contender for
   207 ;; fixture API
   208 (defprompt tpfoo :prompt "testing:")
   209 
   210 (deftest cli-prompt (:skip t)
   211   "Test CLI prompts"
   212   (defvar tcoll nil)
   213   (defvar thist nil)
   214   (let ((*standard-input* (make-string-input-stream 
   215 			   (format nil "~A~%~A~%~%" "foobar" "foobar"))))
   216     ;; prompts 
   217     (is (string= (tpfoo-prompt) "foobar"))
   218     (is (string= "foobar"
   219                  (completing-read "nothing: " tcoll :history thist :default "foobar")))))
   220 
   221 (defparameter *opts* '((:name "foo" :global t :description "bar")
   222 		       (:name "bar" :description "foo")))
   223 
   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 `(:name "baz" :description "baz" :opts ,*opts*) *cmd1* *cmd2*))
   227 
   228 (defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli"))
   229 
   230 
   231 (deftest clap-basic ()
   232   "test basic CLAP functionality."
   233   (let ((cli *cli*))
   234     (is (eq (make-shorty "test") #\t))
   235     (is (equalp (proc-args cli '("-f" "baz" "--bar=fax")) ;; not eql
   236 		(make-cli-ast 
   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")))
   242     (is (stringp
   243 	 (with-output-to-string (s)
   244 	   (print-version cli s)
   245 	   (print-usage cli s)
   246 	   (print-help cli s))))
   247     (is (string= "foobar" (cli/clap:parse-string-opt "foobar")))))
   248 
   249 (make-opt-parser thing *arg*)
   250 
   251 (deftest clap-opts ()
   252   "CLAP opt tests."
   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))))
   257 
   258 (deftest progress ()
   259   (flet ((%step () (cli/progress::update 1)))
   260     (let ((*progress-bar-enabled* t)
   261           (n 100))
   262       (with-progress-bar (n "TEST: # of steps = ~a" n)
   263         (dotimes (i n) (%step))))))
   264 
   265 (deftest spark ()
   266   (is (string= 
   267        (spark '(1 5 22 13 5))
   268        "▁▂█▅▂"))
   269   (is (string= 
   270        (spark '(5.5 20))
   271        "▁█"))
   272   (is (string=
   273        (spark '(1 2 3 4 100 5 10 20 50 300))
   274        "▁▁▁▁▃▁▁▁▂█"))
   275   (is (string=
   276        (spark '(1 50 100))
   277        "▁▄█"))
   278   (is (string=
   279        (spark '(2 4 8))
   280        "▁▃█"))
   281   (is (string=
   282        (spark '(1 2 3 4 5))
   283        "▁▂▄▆█"))
   284   (is (string=
   285        (spark '(0 30 55 80 33 150))
   286        "▁▂▃▄▂█"))
   287   ;; null
   288   (is (string=
   289        (spark '())
   290        ""))
   291   ;; singleton
   292   (is (string=
   293        (spark '(42))
   294        "▁"))
   295   ;; constant
   296   (is (string=
   297        (spark '(42 42))
   298        "▁▁"))
   299   ;; min/max
   300   (is (string=
   301        (spark '(0 30 55 80 33 150) :min -100)
   302        "▃▄▅▆▄█"))
   303   (is (string=
   304        (spark '(0 30 55 80 33 150) :max 50)
   305        "▁▅██▅█"))
   306   (is (string=
   307        (spark '(0 30 55 80 33 150) :min 30 :max 80)
   308        "▁▁▄█▁█"))
   309   ;; double-float, minus
   310   (is (string=
   311        (spark '(1.000000000005d0 0.000000000005d0 1.0d0))
   312        "█▁▇"))
   313   (is (string=
   314        (spark '(-1 0 -1))
   315        "▁█▁"))
   316   (is (string=
   317        (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0))
   318        "▁█▁"))
   319   ;; *ticks*
   320   (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0)))
   321     (is (string=
   322          (spark ternary)
   323          "▁▄█▁█▄▄▁██▄"))
   324     (is (string=
   325          (let ((*ticks* #(#\_ #\- #\¯)))
   326            (spark ternary))
   327          "_-¯_¯--_¯¯-"))
   328     (is (string=
   329          (let ((*ticks* #(#\▄ #\⎯ #\▀)))
   330            (spark ternary))
   331          "▄⎯▀▄▀⎯⎯▄▀▀⎯"))
   332     (is (string=
   333          (let ((*ticks* #(#\E #\O)))
   334            (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2))))
   335          "EEOEE")))
   336   ;; key
   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)
   340                         repeat n
   341                         finally (return x)))
   342          (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc)))))
   343                     (rec n 1))))
   344     (is (string=
   345          (spark (range 0 51)
   346                 :key (lambda (x) (sin (* x pi 1/4))))
   347          "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█"))
   348     (is (string=
   349          (spark (range 0 51)
   350                 :key (lambda (x) (cos (* x pi 1/4))))
   351          "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄"))
   352 
   353     (is (string=
   354          (spark (range 0 51)
   355                 :key (lambda (x) (abs (cis (* x pi 1/4)))))
   356          "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁"))
   357     
   358     (is (string=
   359          (spark (range 0 51)
   360                 :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0)))
   361          "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆"))
   362 
   363     (is (string=
   364          (spark (range 1 7) :key #'log)   
   365          "▁▃▅▆▇█"))
   366 
   367     (is (string=
   368          (spark (range 1 7) :key #'sqrt)  
   369          "▁▃▄▅▆█"))
   370     (is (string=
   371          (spark (range 1 7))              
   372          "▁▂▃▅▆█"))
   373     (is (string=
   374          (spark (range 1 7) :key #'fib)   
   375          "▁▁▂▃▅█"))
   376     (is (string=
   377          (spark (range 1 7) :key #'exp)   
   378          "▁▁▁▁▃█"))
   379     (is (string=
   380          (spark (range 1 7) :key #'fac)   
   381          "▁▁▁▁▂█"))
   382     (is (string=
   383          (spark (range 1 7) :key #'isqrt) 
   384          "▁▁▁███"))
   385     ;; misc
   386     (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2)))))
   387       (is (string=
   388            (lbits 42) 
   389            "█▁█▁█▁"))
   390       (is (string=
   391            (lbits 43) 
   392            "█▁█▁██"))
   393       (is (string=
   394            (lbits 44) 
   395            "█▁██▁▁"))
   396       (is (string= 
   397            (lbits 45) 
   398            "█▁██▁█")))
   399 
   400     ;; VSPARK
   401     (is (string=
   402          (vspark '())
   403          ""))
   404     ;; singleton
   405     (is (string= 
   406          (vspark '(1))
   407          "
   408 1                      1.5                       2
   409 ˫-----------------------+------------------------˧
   410 ▏
   411 "))
   412 
   413     ;; constant
   414     (is (string= 
   415          (vspark '(1 1))
   416          "
   417 1                      1.5                       2
   418 ˫-----------------------+------------------------˧
   419 ▏
   420 ▏
   421 "))
   422 
   423 
   424     (is (string=
   425          (vspark '(0 30 55 80 33 150))
   426          "
   427 0                      75                      150
   428 ˫-----------------------+------------------------˧
   429 ▏
   430 ██████████▏
   431 ██████████████████▍
   432 ██████████████████████████▋
   433 ███████████▏
   434 ██████████████████████████████████████████████████
   435 "))
   436 
   437 
   438     ;; min, max
   439 
   440     (is (string=
   441          (vspark '(0 30 55 80 33 150) :min -100)
   442          "
   443 -100                    25                     150
   444 ˫-----------------------+------------------------˧
   445 ████████████████████▏
   446 ██████████████████████████▏
   447 ███████████████████████████████▏
   448 ████████████████████████████████████▏
   449 ██████████████████████████▋
   450 ██████████████████████████████████████████████████
   451 "))
   452 
   453     (is (string=
   454          (vspark '(0 30 55 80 33 150) :max 50)
   455          "
   456 0                      25                       50
   457 ˫-----------------------+------------------------˧
   458 ▏
   459 ██████████████████████████████▏
   460 ██████████████████████████████████████████████████
   461 ██████████████████████████████████████████████████
   462 █████████████████████████████████▏
   463 ██████████████████████████████████████████████████
   464 "))
   465 
   466 
   467     (is (string=
   468          (vspark '(0 30 55 80 33 150) :min 30 :max 80)
   469          "
   470 30                      55                      80
   471 ˫-----------------------+------------------------˧
   472 ▏
   473 ▏
   474 █████████████████████████▏
   475 ██████████████████████████████████████████████████
   476 ███▏
   477 ██████████████████████████████████████████████████
   478 "))
   479 
   480     ;; labels
   481     (is (string=
   482          (vspark '(1 0 .5) :labels '("on" "off" "unknown")
   483                            :size 1
   484                            :scale? nil)
   485          "
   486      on █
   487     off ▏
   488 unknown ▌
   489 "))
   490 
   491     (is (string=
   492          (vspark '(1 0 .5) :labels '("on" "off")
   493                            :size 1
   494                            :scale? nil)
   495          "
   496  on █
   497 off ▏
   498     ▌
   499 "))
   500 
   501     (is (string=
   502          (vspark '(1 0) :labels '("on" "off" "unknown")
   503                         :size 1
   504                         :scale? nil)
   505          "
   506  on █
   507 off ▏
   508 "))
   509 
   510     ;; key
   511     (is (string=
   512          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))))
   513          "
   514 -1.0                    0.0                    1.0
   515 ˫-----------------------+------------------------˧
   516 █████████████████████████▏
   517 ██████████████████████████████████████████▋
   518 ██████████████████████████████████████████████████
   519 ██████████████████████████████████████████▋
   520 █████████████████████████▏
   521 ███████▍
   522 ▏
   523 ███████▍
   524 ████████████████████████▉
   525 "))
   526 
   527     ;; size
   528     (is (string=
   529          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
   530                                       :size 10)
   531          "
   532 -1.0   1.0
   533 ˫--------˧
   534 █████▏
   535 ████████▌
   536 ██████████
   537 ████████▌
   538 █████▏
   539 █▌
   540 ▏
   541 █▌
   542 ████▉
   543 "))
   544 
   545     ;; scale (mid-point)
   546     (is (string=
   547          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
   548                                       :size 20)
   549          "
   550 -1.0     0.0     1.0
   551 ˫--------+---------˧
   552 ██████████▏
   553 █████████████████▏
   554 ████████████████████
   555 █████████████████▏
   556 ██████████▏
   557 ██▉
   558 ▏
   559 ██▉
   560 █████████▉
   561 "))
   562 
   563     (let ((life-expectancies '(("Africa" 56)
   564                                ("Americans" 76)
   565                                ("South-East Asia" 67)
   566                                ("Europe" 76)
   567                                ("Eastern Mediterranean" 68)
   568                                ("Western Pacific" 76)
   569                                ("Global" 70))))
   570 
   571       (is (string=
   572            (vspark life-expectancies :key #'second)
   573            "
   574 56                      66                      76
   575 ˫-----------------------+------------------------˧
   576 ▏
   577 ██████████████████████████████████████████████████
   578 ███████████████████████████▌
   579 ██████████████████████████████████████████████████
   580 ██████████████████████████████▏
   581 ██████████████████████████████████████████████████
   582 ███████████████████████████████████▏
   583 "))
   584 
   585       ;; newline?
   586       (is (string=
   587            (vspark life-expectancies :key #'second :scale? nil :newline? nil)
   588            "▏
   589 ██████████████████████████████████████████████████
   590 ███████████████████████████▌
   591 ██████████████████████████████████████████████████
   592 ██████████████████████████████▏
   593 ██████████████████████████████████████████████████
   594 ███████████████████████████████████▏"))
   595 
   596       ;; scale?
   597       (is (string=
   598            (vspark life-expectancies :key #'second :scale? nil)
   599            "
   600 ▏
   601 ██████████████████████████████████████████████████
   602 ███████████████████████████▌
   603 ██████████████████████████████████████████████████
   604 ██████████████████████████████▏
   605 ██████████████████████████████████████████████████
   606 ███████████████████████████████████▏
   607 "))
   608 
   609       ;; labels
   610       (is (string=
   611            (vspark life-expectancies
   612                    :key   #'second
   613                    :labels (mapcar #'first life-expectancies))
   614            "
   615                       56           66           76
   616                       ˫------------+-------------˧
   617                Africa ▏
   618             Americans ████████████████████████████
   619       South-East Asia ███████████████▍
   620                Europe ████████████████████████████
   621 Eastern Mediterranean ████████████████▊
   622       Western Pacific ████████████████████████████
   623                Global ███████████████████▋
   624 "))
   625 
   626       ;; title
   627       (is (string=
   628            (vspark life-expectancies
   629                    :min 50 :max 80
   630                    :key    #'second
   631                    :labels (mapcar #'first life-expectancies)
   632                    :title "Life Expectancy")
   633            "
   634                  Life Expectancy                  
   635                       50           65           80
   636                       ˫------------+-------------˧
   637                Africa █████▋
   638             Americans ████████████████████████▎
   639       South-East Asia ███████████████▉
   640                Europe ████████████████████████▎
   641 Eastern Mediterranean ████████████████▊
   642       Western Pacific ████████████████████████▎
   643                Global ██████████████████▋
   644 "))
   645 
   646       (is (string=
   647            (spark (range 0 15) :key #'fib)
   648            "▁▁▁▁▁▁▁▁▁▁▂▂▃▅█"))
   649 
   650       (is (string=
   651            (vspark (range 0 15) :key #'fib)
   652            "
   653 0                    188.5                     377
   654 ˫-----------------------+------------------------˧
   655 ▏
   656 ▏
   657 ▏
   658 ▎
   659 ▍
   660 ▋
   661 █▏
   662 █▊
   663 ██▊
   664 ████▌
   665 ███████▍
   666 ███████████▊
   667 ███████████████████▏
   668 ██████████████████████████████▉
   669 ██████████████████████████████████████████████████
   670 ")))))
   671 
   672 (deftest repl ())
   673 
   674 (deftest env ()
   675   (is (ld-library-path-list))
   676   (is (exec-path-list))
   677   (is (find-exe "sbcl")))
   678 
   679 (deftest cli-ast ()
   680   "Validate the CLI/CLAP/AST parser."
   681   (with-cli () *cli*
   682     (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1"))))))
   683                  "foo"))
   684     (is (string=
   685          (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo=11"))))))
   686          "foo"))))
   687 
   688 (defmain (:exit nil :export nil)
   689   (with-cli () *cli*
   690     (log:trace! "defmain is OK")
   691     t))
   692 
   693 (deftest clap-main ()
   694   (is (null (funcall #'main))))
   695 
   696 (deftest sbcl-tools ()
   697   (with-sbcl (:noinform t :quit t)
   698     (print 1)))