--- 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)
--- 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)'
--- 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:** <https://sjl.bitbucket.io/adopt/>
* **Mercurial:** <https://bitbucket.org/sjl/adopt/>
* **Git:** <https://github.com/sjl/adopt/>
+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
--- 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
--- 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))))
--- 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")))))