changelog shortlog graph tags branches changeset files revisions annotate raw help

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

changeset 688: 517c65b51e6b
child: 2e7d93b892a5
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 01 Oct 2024 21:52:17 -0400
permissions: -rw-r--r--
description: clap tests 
     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 (deftest progress ()
   222   (flet ((%step () (cli/progress::update 1)))
   223     (let ((*progress-bar-enabled* t)
   224           (n 100))
   225       (with-progress-bar (n "TEST: # of steps = ~a" n)
   226         (dotimes (i n) (%step))))))
   227 
   228 (deftest spark ()
   229   (is (string= 
   230        (spark '(1 5 22 13 5))
   231        "▁▂█▅▂"))
   232   (is (string= 
   233        (spark '(5.5 20))
   234        "▁█"))
   235   (is (string=
   236        (spark '(1 2 3 4 100 5 10 20 50 300))
   237        "▁▁▁▁▃▁▁▁▂█"))
   238   (is (string=
   239        (spark '(1 50 100))
   240        "▁▄█"))
   241   (is (string=
   242        (spark '(2 4 8))
   243        "▁▃█"))
   244   (is (string=
   245        (spark '(1 2 3 4 5))
   246        "▁▂▄▆█"))
   247   (is (string=
   248        (spark '(0 30 55 80 33 150))
   249        "▁▂▃▄▂█"))
   250   ;; null
   251   (is (string=
   252        (spark '())
   253        ""))
   254   ;; singleton
   255   (is (string=
   256        (spark '(42))
   257        "▁"))
   258   ;; constant
   259   (is (string=
   260        (spark '(42 42))
   261        "▁▁"))
   262   ;; min/max
   263   (is (string=
   264        (spark '(0 30 55 80 33 150) :min -100)
   265        "▃▄▅▆▄█"))
   266   (is (string=
   267        (spark '(0 30 55 80 33 150) :max 50)
   268        "▁▅██▅█"))
   269   (is (string=
   270        (spark '(0 30 55 80 33 150) :min 30 :max 80)
   271        "▁▁▄█▁█"))
   272   ;; double-float, minus
   273   (is (string=
   274        (spark '(1.000000000005d0 0.000000000005d0 1.0d0))
   275        "█▁▇"))
   276   (is (string=
   277        (spark '(-1 0 -1))
   278        "▁█▁"))
   279   (is (string=
   280        (spark '(-1.000000000005d0 0.000000000005d0 -1.0d0))
   281        "▁█▁"))
   282   ;; *ticks*
   283   (let ((ternary '(-1 0 1 -1 1 0 0 -1 1 1 0)))
   284     (is (string=
   285          (spark ternary)
   286          "▁▄█▁█▄▄▁██▄"))
   287     (is (string=
   288          (let ((*ticks* #(#\_ #\- #\¯)))
   289            (spark ternary))
   290          "_-¯_¯--_¯¯-"))
   291     (is (string=
   292          (let ((*ticks* #(#\▄ #\⎯ #\▀)))
   293            (spark ternary))
   294          "▄⎯▀▄▀⎯⎯▄▀▀⎯"))
   295     (is (string=
   296          (let ((*ticks* #(#\E #\O)))
   297            (spark '(4 8 15 22 42) :key (lambda (n) (mod n 2))))
   298          "EEOEE")))
   299   ;; key
   300   (flet ((range (start end) (loop for i from start below end collect i))
   301          (fib (n) (loop for x = 0 then y
   302                         and y = 1 then (+ x y)
   303                         repeat n
   304                         finally (return x)))
   305          (fac (n) (labels ((rec (n acc) (if (<= n 1) acc (rec (1- n) (* n acc)))))
   306                     (rec n 1))))
   307     (is (string=
   308          (spark (range 0 51)
   309                 :key (lambda (x) (sin (* x pi 1/4))))
   310          "▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█"))
   311     (is (string=
   312          (spark (range 0 51)
   313                 :key (lambda (x) (cos (* x pi 1/4))))
   314          "█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄▂▁▂▄▆█▆▄"))
   315 
   316     (is (string=
   317          (spark (range 0 51)
   318                 :key (lambda (x) (abs (cis (* x pi 1/4)))))
   319          "▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁"))
   320     
   321     (is (string=
   322          (spark (range 0 51)
   323                 :key (lambda (x) (float (phase (cis (* x pi 1/4))) 1.0)))
   324          "▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆▇█▁▁▂▄▅▆"))
   325 
   326     (is (string=
   327          (spark (range 1 7) :key #'log)   
   328          "▁▃▅▆▇█"))
   329 
   330     (is (string=
   331          (spark (range 1 7) :key #'sqrt)  
   332          "▁▃▄▅▆█"))
   333     (is (string=
   334          (spark (range 1 7))              
   335          "▁▂▃▅▆█"))
   336     (is (string=
   337          (spark (range 1 7) :key #'fib)   
   338          "▁▁▂▃▅█"))
   339     (is (string=
   340          (spark (range 1 7) :key #'exp)   
   341          "▁▁▁▁▃█"))
   342     (is (string=
   343          (spark (range 1 7) :key #'fac)   
   344          "▁▁▁▁▂█"))
   345     (is (string=
   346          (spark (range 1 7) :key #'isqrt) 
   347          "▁▁▁███"))
   348     ;; misc
   349     (flet ((lbits (n) (spark (map 'list #'digit-char-p (write-to-string n :base 2)))))
   350       (is (string=
   351            (lbits 42) 
   352            "█▁█▁█▁"))
   353       (is (string=
   354            (lbits 43) 
   355            "█▁█▁██"))
   356       (is (string=
   357            (lbits 44) 
   358            "█▁██▁▁"))
   359       (is (string= 
   360            (lbits 45) 
   361            "█▁██▁█")))
   362 
   363     ;; VSPARK
   364     (is (string=
   365          (vspark '())
   366          ""))
   367     ;; singleton
   368     (is (string= 
   369          (vspark '(1))
   370          "
   371 1                      1.5                       2
   372 ˫-----------------------+------------------------˧
   373 ▏
   374 "))
   375 
   376     ;; constant
   377     (is (string= 
   378          (vspark '(1 1))
   379          "
   380 1                      1.5                       2
   381 ˫-----------------------+------------------------˧
   382 ▏
   383 ▏
   384 "))
   385 
   386 
   387     (is (string=
   388          (vspark '(0 30 55 80 33 150))
   389          "
   390 0                      75                      150
   391 ˫-----------------------+------------------------˧
   392 ▏
   393 ██████████▏
   394 ██████████████████▍
   395 ██████████████████████████▋
   396 ███████████▏
   397 ██████████████████████████████████████████████████
   398 "))
   399 
   400 
   401     ;; min, max
   402 
   403     (is (string=
   404          (vspark '(0 30 55 80 33 150) :min -100)
   405          "
   406 -100                    25                     150
   407 ˫-----------------------+------------------------˧
   408 ████████████████████▏
   409 ██████████████████████████▏
   410 ███████████████████████████████▏
   411 ████████████████████████████████████▏
   412 ██████████████████████████▋
   413 ██████████████████████████████████████████████████
   414 "))
   415 
   416     (is (string=
   417          (vspark '(0 30 55 80 33 150) :max 50)
   418          "
   419 0                      25                       50
   420 ˫-----------------------+------------------------˧
   421 ▏
   422 ██████████████████████████████▏
   423 ██████████████████████████████████████████████████
   424 ██████████████████████████████████████████████████
   425 █████████████████████████████████▏
   426 ██████████████████████████████████████████████████
   427 "))
   428 
   429 
   430     (is (string=
   431          (vspark '(0 30 55 80 33 150) :min 30 :max 80)
   432          "
   433 30                      55                      80
   434 ˫-----------------------+------------------------˧
   435 ▏
   436 ▏
   437 █████████████████████████▏
   438 ██████████████████████████████████████████████████
   439 ███▏
   440 ██████████████████████████████████████████████████
   441 "))
   442 
   443     ;; labels
   444     (is (string=
   445          (vspark '(1 0 .5) :labels '("on" "off" "unknown")
   446                            :size 1
   447                            :scale? nil)
   448          "
   449      on █
   450     off ▏
   451 unknown ▌
   452 "))
   453 
   454     (is (string=
   455          (vspark '(1 0 .5) :labels '("on" "off")
   456                            :size 1
   457                            :scale? nil)
   458          "
   459  on █
   460 off ▏
   461     ▌
   462 "))
   463 
   464     (is (string=
   465          (vspark '(1 0) :labels '("on" "off" "unknown")
   466                         :size 1
   467                         :scale? nil)
   468          "
   469  on █
   470 off ▏
   471 "))
   472 
   473     ;; key
   474     (is (string=
   475          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))))
   476          "
   477 -1.0                    0.0                    1.0
   478 ˫-----------------------+------------------------˧
   479 █████████████████████████▏
   480 ██████████████████████████████████████████▋
   481 ██████████████████████████████████████████████████
   482 ██████████████████████████████████████████▋
   483 █████████████████████████▏
   484 ███████▍
   485 ▏
   486 ███████▍
   487 ████████████████████████▉
   488 "))
   489 
   490     ;; size
   491     (is (string=
   492          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
   493                                       :size 10)
   494          "
   495 -1.0   1.0
   496 ˫--------˧
   497 █████▏
   498 ████████▌
   499 ██████████
   500 ████████▌
   501 █████▏
   502 █▌
   503 ▏
   504 █▌
   505 ████▉
   506 "))
   507 
   508     ;; scale (mid-point)
   509     (is (string=
   510          (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))
   511                                       :size 20)
   512          "
   513 -1.0     0.0     1.0
   514 ˫--------+---------˧
   515 ██████████▏
   516 █████████████████▏
   517 ████████████████████
   518 █████████████████▏
   519 ██████████▏
   520 ██▉
   521 ▏
   522 ██▉
   523 █████████▉
   524 "))
   525 
   526     (let ((life-expectancies '(("Africa" 56)
   527                                ("Americans" 76)
   528                                ("South-East Asia" 67)
   529                                ("Europe" 76)
   530                                ("Eastern Mediterranean" 68)
   531                                ("Western Pacific" 76)
   532                                ("Global" 70))))
   533 
   534       (is (string=
   535            (vspark life-expectancies :key #'second)
   536            "
   537 56                      66                      76
   538 ˫-----------------------+------------------------˧
   539 ▏
   540 ██████████████████████████████████████████████████
   541 ███████████████████████████▌
   542 ██████████████████████████████████████████████████
   543 ██████████████████████████████▏
   544 ██████████████████████████████████████████████████
   545 ███████████████████████████████████▏
   546 "))
   547 
   548       ;; newline?
   549       (is (string=
   550            (vspark life-expectancies :key #'second :scale? nil :newline? nil)
   551            "▏
   552 ██████████████████████████████████████████████████
   553 ███████████████████████████▌
   554 ██████████████████████████████████████████████████
   555 ██████████████████████████████▏
   556 ██████████████████████████████████████████████████
   557 ███████████████████████████████████▏"))
   558 
   559       ;; scale?
   560       (is (string=
   561            (vspark life-expectancies :key #'second :scale? nil)
   562            "
   563 ▏
   564 ██████████████████████████████████████████████████
   565 ███████████████████████████▌
   566 ██████████████████████████████████████████████████
   567 ██████████████████████████████▏
   568 ██████████████████████████████████████████████████
   569 ███████████████████████████████████▏
   570 "))
   571 
   572       ;; labels
   573       (is (string=
   574            (vspark life-expectancies
   575                    :key   #'second
   576                    :labels (mapcar #'first life-expectancies))
   577            "
   578                       56           66           76
   579                       ˫------------+-------------˧
   580                Africa ▏
   581             Americans ████████████████████████████
   582       South-East Asia ███████████████▍
   583                Europe ████████████████████████████
   584 Eastern Mediterranean ████████████████▊
   585       Western Pacific ████████████████████████████
   586                Global ███████████████████▋
   587 "))
   588 
   589       ;; title
   590       (is (string=
   591            (vspark life-expectancies
   592                    :min 50 :max 80
   593                    :key    #'second
   594                    :labels (mapcar #'first life-expectancies)
   595                    :title "Life Expectancy")
   596            "
   597                  Life Expectancy                  
   598                       50           65           80
   599                       ˫------------+-------------˧
   600                Africa █████▋
   601             Americans ████████████████████████▎
   602       South-East Asia ███████████████▉
   603                Europe ████████████████████████▎
   604 Eastern Mediterranean ████████████████▊
   605       Western Pacific ████████████████████████▎
   606                Global ██████████████████▋
   607 "))
   608 
   609       (is (string=
   610            (spark (range 0 15) :key #'fib)
   611            "▁▁▁▁▁▁▁▁▁▁▂▂▃▅█"))
   612 
   613       (is (string=
   614            (vspark (range 0 15) :key #'fib)
   615            "
   616 0                    188.5                     377
   617 ˫-----------------------+------------------------˧
   618 ▏
   619 ▏
   620 ▏
   621 ▎
   622 ▍
   623 ▋
   624 █▏
   625 █▊
   626 ██▊
   627 ████▌
   628 ███████▍
   629 ███████████▊
   630 ███████████████████▏
   631 ██████████████████████████████▉
   632 ██████████████████████████████████████████████████
   633 ")))))
   634 
   635 (deftest repl ())
   636 
   637 (deftest env ()
   638   (ld-library-path-list)
   639   (is (exec-path-list))
   640   (is (find-exe "sbcl")))
   641 
   642 (deftest sbcl-tools ()
   643   (with-sbcl (:noinform t :quit t)
   644     (print 1)))