4921979d07a8

Add duplicate option checks, update test suite
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 21 May 2019 22:05:24 -0400
parents c0e14a25c572
children 502eaba9e114
branches/tags (none)
files .lispwords Makefile README.markdown docs/index.markdown src/main.lisp test/tests.lisp

Changes

--- 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")))))