changelog shortlog graph tags branches changeset files revisions annotate raw help

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

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