# HG changeset patch # User Steve Losh # Date 1558490724 14400 # Node ID 4921979d07a8918d9acf7e0331c9bc3be7629200 # Parent c0e14a25c572381438dced4b790125cba9caa3ab Add duplicate option checks, update test suite diff -r c0e14a25c572 -r 4921979d07a8 .lispwords --- a/.lispwords Mon May 20 19:34:36 2019 -0400 +++ b/.lispwords Tue May 21 22:05:24 2019 -0400 @@ -1,1 +1,2 @@ (1 make-option) +(1 signals) diff -r c0e14a25c572 -r 4921979d07a8 Makefile --- a/Makefile Mon May 20 19:34:36 2019 -0400 +++ b/Makefile Tue May 21 22:05:24 2019 -0400 @@ -1,4 +1,4 @@ -.PHONY: test test-sbcl test-ccl test-ecl test-abcl pubdocs +.PHONY: test test-sbcl test-ccl test-ecl test-abcl test-clasp pubdocs heading_printer = $(shell which heading || echo 'true') sourcefiles = $(shell ffind --full-path --literal .lisp) @@ -6,7 +6,7 @@ apidocs = $(shell ls docs/*reference*.markdown) # Testing --------------------------------------------------------------------- -test: test-sbcl test-ccl test-ecl test-abcl +test: test-sbcl test-ccl test-ecl test-abcl test-clasp test-sbcl: $(heading_printer) computer 'SBCL' @@ -24,6 +24,10 @@ $(heading_printer) broadway 'ABCL' time abcl --load test/run.lisp +test-clasp: + $(heading_printer) o8 'CLASP' + time clasp --load test/run.lisp + # Documentation --------------------------------------------------------------- $(apidocs): $(sourcefiles) sbcl --noinform --load docs/api.lisp --eval '(quit)' diff -r c0e14a25c572 -r 4921979d07a8 README.markdown --- a/README.markdown Mon May 20 19:34:36 2019 -0400 +++ b/README.markdown Tue May 21 22:05:24 2019 -0400 @@ -4,13 +4,27 @@ I needed **a** **d**amn **opt**ion parsing library. Adopt is a simple UNIX-style option parser in Common Lisp, heavily influenced by -Python's optparse and argparse. It depends on [Bobbin][] and -[split-sequence][]. +Python's optparse and argparse. * **License:** MIT * **Documentation:** * **Mercurial:** * **Git:** +Adopt aims to be a simple, robust option parser. It can automatically print +help information and even generate `man` pages for you. + +Adopt is compatible with Quicklisp, but not *in* Quicklisp (yet). You can clone +the repository into your [Quicklisp local-projects directory][local] for now. + +The `adopt` system contains the core API and depends on [Bobbin][] and +[split-sequence][]. + +The `adopt/test` system contains the test suite, which depends on some other +systems. You don't need to load this unless you want to run the unit tests. +The tests pass on SBCL, CCL, ECL, and ABCL on Ubuntu 18.04. Further testing is +welcome. + +[local]: https://www.quicklisp.org/beta/faq.html#local-project [Bobbin]: https://github.com/sjl/bobbin [split-sequence]: https://www.cliki.net/split-sequence diff -r c0e14a25c572 -r 4921979d07a8 docs/index.markdown --- a/docs/index.markdown Mon May 20 19:34:36 2019 -0400 +++ b/docs/index.markdown Tue May 21 22:05:24 2019 -0400 @@ -19,6 +19,8 @@ The `adopt/test` system contains the test suite, which depends on some other systems. You don't need to load this unless you want to run the unit tests. +The tests pass on SBCL, CCL, ECL, and ABCL on Ubuntu 18.04. Further testing is +welcome. [local]: https://www.quicklisp.org/beta/faq.html#local-project [Bobbin]: https://github.com/sjl/bobbin diff -r c0e14a25c572 -r 4921979d07a8 src/main.lisp --- a/src/main.lisp Mon May 20 19:34:36 2019 -0400 +++ b/src/main.lisp Tue May 21 22:05:24 2019 -0400 @@ -237,8 +237,12 @@ (let ((short (short option)) (long (long option))) (when short + (when (gethash short (short-options interface)) + (error "Duplicate short option ~S." short)) (setf (gethash short (short-options interface)) option)) (when long + (when (gethash long (long-options interface)) + (error "Duplicate long option ~S." long)) (setf (gethash long (long-options interface)) option))))) (dolist (g groups) (map nil #'add-option (options g)))) diff -r c0e14a25c572 -r 4921979d07a8 test/tests.lisp --- a/test/tests.lisp Mon May 20 19:34:36 2019 -0400 +++ b/test/tests.lisp Tue May 21 22:05:24 2019 -0400 @@ -38,31 +38,45 @@ (is (equal ,expected-args ,args)) (is (hash-table-equal ,expected-result ,result))))) +(defun ct () (constantly t)) + ;;;; Tests -------------------------------------------------------------------- (defparameter *noop* - (adopt:make-interface)) + (adopt:make-interface + :name "noop" + :summary "no options" + :help "this interface has no options" + :usage "")) (defparameter *option-types* (adopt:make-interface + :name "option-types" + :summary "testing option types" + :help "this interface tests both option types" + :usage "[OPTIONS]" :contents (list (adopt:make-option 'long :help "long only" :long "long" - :reduce (constantly t)) + :reduce (ct)) (adopt:make-option 'short :help "short only" :short #\s - :reduce (constantly t)) + :reduce (ct)) (adopt:make-option 'both :help "both short and long" :short #\b :long "both" - :reduce (constantly t))))) + :reduce (ct))))) (defparameter *reducers* (adopt:make-interface + :name "reducers" + :summary "testing reducers" + :help "this interface tests basic reducers" + :usage "[OPTIONS]" :contents (list (adopt:make-option 'c1 @@ -94,6 +108,10 @@ (defparameter *same-key* (adopt:make-interface + :name "same-key" + :summary "testing same keys" + :help "this interface tests options with the same result-key" + :usage "[OPTIONS]" :contents (list (adopt:make-option '1 @@ -109,6 +127,10 @@ (defparameter *initial-value* (adopt:make-interface + :name "initial-value" + :summary "testing initial values" + :help "this interface tests the initial-value argument" + :usage "[OPTIONS]" :contents (list (adopt:make-option 'foo @@ -120,6 +142,10 @@ (defparameter *finally* (adopt:make-interface + :name "finally" + :summary "testing finally" + :help "this interface tests the finally argument" + :usage "[OPTIONS]" :contents (list (adopt:make-option 'yell @@ -140,8 +166,12 @@ (assert (string= "a" a)) :ok))))) -(defparameter *keys* +(defparameter *key* (adopt:make-interface + :name "key" + :summary "testing key" + :help "this interface tests the key argument" + :usage "[OPTIONS]" :contents (list (adopt:make-option 'int @@ -196,7 +226,12 @@ '("foo" "bar") (result 'short t 'long t - 'both t))) + 'both t)) + ;; Make sure we require at least one of short/long. + (is + (adopt:make-option 'foo :reduce (ct) :help "this should work" :short #\x)) + (signals error + (adopt:make-option 'foo :reduce (ct) :help "this should not work"))) (define-test reducers (check *reducers* "" @@ -248,12 +283,12 @@ '("x" "y") (result 'foo "goodbye"))) -(define-test keys - (check *keys* "" +(define-test key + (check *key* "" '() (result 'len '() 'int '())) - (check *keys* "--int 123 --int 0 --len abc --len 123456" + (check *key* "--int 123 --int 0 --len abc --len 123456" '() (result 'int '(123 0) 'len '(3 6)))) @@ -272,3 +307,20 @@ (is (equal '(:a) (adopt:collect '() :a))) (is (equal '(:a :b) (adopt:collect '(:a) :b))) (is (equal '(2 . 1) (funcall (adopt:flip 'cons) 1 2)))) + +(define-test duplicate-options + (is + (adopt:make-interface + :name "" :summary "" :help "" :usage "" :contents + (list (adopt:make-option 'foo :reduce (ct) :help "" :short #\a :long "foo") + (adopt:make-option 'bar :reduce (ct) :help "" :short #\b :long "bar")))) + (signals error + (adopt:make-interface + :name "" :summary "" :help "" :usage "" :contents + (list (adopt:make-option 'foo :reduce (ct) :help "" :short #\a :long "foo") + (adopt:make-option 'bar :reduce (ct) :help "" :short #\a :long "bar")))) + (signals error + (adopt:make-interface + :name "" :summary "" :help "" :usage "" :contents + (list (adopt:make-option 'foo :reduce (ct) :help "" :short #\a :long "oops") + (adopt:make-option 'bar :reduce (ct) :help "" :short #\b :long "oops")))))