changelog shortlog graph tags branches changeset files revisions annotate raw help

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

changeset 688: 517c65b51e6b
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 01 Oct 2024 21:52:17 -0400
permissions: -rw-r--r--
description: clap tests 
     1 ;;; clap.lisp --- CLAP tests
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 (in-package :cli/tests)
     7 (in-suite :cli)
     8 
     9 (defcmd flub-thunk
    10   ;; FIX 2024-10-01: 
    11   (println *optc*)
    12   (println *argc*)
    13   (print *opts*)
    14   (print *args*))
    15 
    16 (defparameter *opts* '((:name "foo" :description "bar" :kind string)
    17                        (:name "bar" :description "foo" :kind string)))
    18 (defparameter *cmd1* (make-cli :cmd :name "holla" :opts *opts* :description "cmd1 description"))
    19 (defparameter *cmd2* (make-cli :cmd :name "ayo" :cmds (vector *cmd1*) :opts *opts* :description "cmd1 description"))
    20 (defparameter *cmd3* (make-cli :cmd :name "flub" :opts *opts* :thunk 'flub-thunk))
    21 (defparameter *cmds* (make-cmds (list `(:name "baz" :description "baz" :opts ,*opts*) *cmd1* *cmd2* *cmd3*)))
    22 
    23 (defparameter *cli* (make-cli :cli :opts *opts* :cmds *cmds* :description "test cli"))
    24 
    25 (deftest mixed-args ()
    26   (with-cli (*cli*) '("--foo" "bar" "flub") 
    27     (is (string= "bar" (cli-opt-val (aref (opts *cli*) 0))))
    28     (is (null (cli-args *cli*)))
    29     (do-cmd *cli*)))
    30 
    31 (deftest cli-ast ()
    32   "Validate the CLI/CLAP/AST parser."
    33   (is (string= (cli-opt-name (cli-node-form (car (ast (proc-args *cli* '("--foo" "1"))))))
    34                "foo"))
    35   (signals clap-unknown-argument
    36     (proc-args *cli* '("--log" "default" "--foo=11"))))
    37 
    38 (defmain foo-main (:exit nil)
    39   (with-cli (*cli*) ()
    40     (log:trace! "defmain is OK")
    41     t))
    42 
    43 (deftest clap-main ()
    44   (is (null (funcall #'foo-main))))
    45 
    46 (deftest clap-basic (:skip t)
    47   "test basic CLAP functionality."
    48   (with-cli (*cli* opts cmds args) *args*
    49     (is (eq (make-shorty "test") #\t))
    50     (is (equalp (proc-args *cli* '("-f" "baz" "--bar=fax")) ;; not eql
    51                 (make-cli-ast 
    52                  (list (make-cli-node 'opt (find-short-opts *cli* #\f))
    53                        (make-cli-node 'cmd (find-cmd *cli* "baz"))
    54                        (make-cli-node 'opt (find-opts *cli* "bar"))
    55                        (make-cli-node 'arg "fax")))))
    56     (is (parse-args *cli* '("--bar" "baz" "-f" "yaks")))
    57     (is (stringp
    58        (with-output-to-string (s)
    59          (print-version *cli* s)
    60          (print-usage *cli* s)
    61          (print-help *cli* s))))
    62   (is (string= "foobar" (cli/clap:parse-string-opt "foobar")))
    63   (do-cmd *cli*)))
    64 
    65 (deftest clap-opts ()
    66   "CLAP opt tests."
    67   (make-opt-parser trivial *arg*)
    68   (is (reduce (lambda (x y) (and x y))
    69               (loop for k across *cli-opt-kinds* collect (cli-opt-kind-p k))))
    70   (is (parse-trivial-opt t))
    71   (is (null (parse-trivial-opt nil))))