Merge branch 'master' into dev; added ambiguous-option

Added test for libre-man#15
digikar99 · May 22, 2020 · 929ee5f · 929ee5f
2 parents 16ba2ef + 9f6ae6e
commit 929ee5f
Show file tree

Hide file tree

Showing 5 changed files with 77 additions and 39 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,4 +1,5 @@
 *.fas
 *.fasl
 *~
+*.o
 \#*
diff --git a/.travis.yml b/.travis.yml
@@ -4,6 +4,14 @@ sudo: required
 git:
   depth: 2
 
+addons:
+  apt:
+    sources:
+      - ubuntu-toolchain-r-test
+    packages:
+      - libstdc++-7-dev
+      - lib32stdc++-7-dev
+
 env:
   matrix:
 #    - LISP=abcl
@@ -13,14 +21,19 @@ env:
 #    - LISP=ccl32
 #    - LISP=clisp
 #    - LISP=clisp32
+#    - LISP=ecl
+
+matrix:
+  allow_failures:
+    - env: LISP=ccl32 # issue filed at https://github.com/Clozure/ccl/issues/304
 
 install:
   - # installing cl-travis
     if [ -x ./install.sh ] && head -2 ./install.sh | grep '^# cl-travis' > /dev/null;
     then
       ./install.sh;
     else
-      curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | sh;
+      curl https://raw.githubusercontent.com/sionescu/cl-travis/master/install.sh | sh;
     fi
 
 before_script:

diff --git a/README.md b/README.md
@@ -1,7 +1,7 @@
 # Unix-style command line options parser
 
 [![License MIT](https://img.shields.io/badge/license-MIT-green.svg)](http://opensource.org/licenses/MIT)
-[![Build Status](https://travis-ci.org/mrkkrp/unix-opts.svg?branch=master)](https://travis-ci.org/mrkkrp/unix-opts)
+[![Build Status](https://travis-ci.org/mrkkrp/unix-opts.svg?branch=master)](https://travis-ci.com/digikar99/unix-opts.svg?branch=master)
 [![Quicklisp](http://quickdocs.org/badge/unix-opts.svg)](http://quickdocs.org/unix-opts/)
 
 This is a minimalistic parser of command line options. The main advantage of

diff --git a/tests.lisp b/tests.lisp
@@ -47,6 +47,11 @@
          :long "grab-str"
          :arg-parser #'identity
          :meta-var "STR")
+  (:name :grab-string
+         :description "grab string STR"
+         :short #\s
+         :long "grab-string"
+         :arg-parser #'identity)
   (:name :flag-a
          :description "flag with short form only"
          :short #\a)
@@ -56,15 +61,11 @@
 
 ;;; Here is some variables that we will use and functions to reset them.
 
-(defparameter *unknown-options* nil
-  "We collect all unknown options here.")
-
+(defparameter *unknown-options* nil "We collect all unknown options here.")
+(defparameter *ambiguous-options* nil "We collect all ambiguous options here.")
 (defparameter *missing-arg-options* nil
   "Options that need an argument, but don't get one.")
-
-(defparameter *malformed-arguments* nil
-  "Here we collect malformed arguments.")
-
+(defparameter *malformed-arguments* nil "Here we collect malformed arguments.")
 (defparameter *missing-required-options*
   "Here we collect missing required options.")
 
@@ -85,7 +86,8 @@ aspects of the tests."
 
 ;;; The tests themselves.
 
-(defun parse-opts (opts &key unknown-option missing-arg arg-parser-failed missing-required)
+(defun parse-opts (opts &key unknown-option missing-arg arg-parser-failed
+                          missing-required ambiguous-option)
   "Parse OPTS, return results and collect some data in special variables.
 Keyword arguments allow to set arguments for `invoke-restart' function. It's
 recommended to supply them all if you don't want to end in the debugger."
@@ -97,6 +99,11 @@ recommended to supply them all if you don't want to end in the debugger."
               (push (option c) *unknown-options*)
               (when unknown-option
                 (apply #'invoke-restart unknown-option))))
+           (ambiguous-option
+            (lambda (c)
+              (push (option c) *ambiguous-options*)
+              (when ambiguous-option
+                (apply #'invoke-restart ambiguous-option))))
            (missing-arg
             (lambda (c)
               (push (option c) *missing-arg-options*)
@@ -191,11 +198,12 @@ recommended to supply them all if you don't want to end in the debugger."
       (parse-opts '("--grab-int" "10" "--grab" "14" "--grab-s")
                   :unknown-option    '(skip-option)
                   :missing-arg       '(skip-option)
-                  :arg-parser-failed '(skip-option))
+                  :arg-parser-failed '(skip-option)
+                  :ambiguous-option  '(skip-option))
     (is (equalp options '(:grab-int 10)))
     (is (equalp free-args '("14")))
-    (is (equalp *unknown-options* '("--grab")))
-    (is (equalp *missing-arg-options* '("--grab-s")))
+    (is (null (set-difference *ambiguous-options* '("--grab" "--grab-s")
+                              :test #'equal)))
     (is (equalp *malformed-arguments* nil))))
 
 (def-test miscelleneous-6 ()

diff --git a/unix-opts.lisp b/unix-opts.lisp
@@ -27,6 +27,7 @@
   (:nicknames :opts)
   (:use       #:common-lisp)
   (:export    #:unknown-option
+              #:ambiguous-option
               #:missing-arg
               #:arg-parser-failed
               #:missing-required-option
@@ -94,6 +95,14 @@ particular option."))
   (:documentation "This condition is thrown when parser encounters
 unknown (not previously defined with `define-opts') option."))
 
+(define-condition ambiguous-option (troublesome-option)
+  ((matches :initarg :matches :reader matches))
+  (:report (lambda (c s) (format s "ambiguous option: ~s~%Matches to ~a"
+                                 (option c) (mapcar #'long (matches c)))))
+  (:documentation "This condition is thrown when parser encounters
+an option that could possibly parse to more than one option. Such a situation
+arises, for example, in `ls --al`."))
+
 (define-condition missing-arg (troublesome-option)
   ()
   (:report (lambda (c s) (format s "missing arg for option: ~s" (option c))))
@@ -255,12 +264,15 @@ the program as first elements of the list. Portable across implementations."
                (when (>= (length x) (length opt))
                  (string= x opt :end1 (length opt))))))
       ;; Yes we use prefix, because `ls --al`, `ls --all`, `ls --alm`.
-      (let ((matches (remove-if-not #'prefix-p *options* :key key)))
+      (let* ((matches (remove-if-not #'prefix-p *options* :key key))
+             (exact-match (find-if #'(lambda (x) (string= x opt))
+                                   matches :key key)))
         ;; Return "the" match if unique
         ;; TODO: Should we raise ambiguous option error
-        (if (cadr matches)
-            nil
-            (car matches))))))
+        (cond
+          (exact-match exact-match)
+          ((cadr matches) matches)
+          (t (car matches)))))))
 
 (defun get-opts (&optional options)
   "Parse command line options. If OPTIONS is given, it should be a list to
@@ -307,10 +319,10 @@ to `nil')"
                                (or options (cdr (argv)))))
                (cdr tokens))
        (required (loop :with table = (make-hash-table)
-                       :for option :in *options*
-                       :when (required option)
-                         :do (setf (gethash (name option) table) option)
-                       :finally (return table)))
+                    :for option :in *options*
+                    :when (required option)
+                    :do (setf (gethash (name option) table) option)
+                    :finally (return table)))
        poption-name
        poption-raw
        poption-parser
@@ -321,16 +333,16 @@ to `nil')"
        (progn
          (when (/= (hash-table-count required) 0)
            (let ((missing (loop :for val :being :the :hash-values :of required
-                                :collect val)))
+                             :collect val)))
              (restart-case
                  (error 'missing-required-option
                         :missing-options missing)
                (skip-option ())
                (use-value (values)
                  (loop :for option :in missing
-                       :for value :in values
-                       :do (push (name option) options)
-                       :do (push value options))))))
+                    :for value :in values
+                    :do (push (name option) options)
+                    :do (push value options))))))
          (values (nreverse options)
                  (nreverse free-args))))
     (labels ((push-option (name value)
@@ -355,20 +367,24 @@ to `nil')"
                    (process-arg str))))
              (process-option (opt)
                (let ((option (find-option opt)))
-                 (if option
-                     (let ((parser (arg-parser option)))
-                       (remhash (name option) required)
-                       (if parser
-                           (setf poption-name   (name option)
-                                 poption-raw    opt
-                                 poption-parser parser)
-                           (push-option (name option) t)))
-                     (restart-case
-                         (error 'unknown-option
-                                :option opt)
-                       (use-value (value)
-                         (process-option value))
-                       (skip-option ()))))))
+                 (cond ((and (listp option) (cadr option)) ; (> length 1)
+                        (restart-case (error 'ambiguous-option :option opt
+                                             :matches option)
+                          (use-value (value) (process-option value))
+                          (skip-option ())))
+                       (option
+                        (let ((parser (arg-parser option)))
+                          (remhash (name option) required)
+                          (if parser
+                              (setf poption-name   (name option)
+                                    poption-raw    opt
+                                    poption-parser parser)
+                              (push-option (name option) t))))
+                       (t
+                        (restart-case
+                            (error 'unknown-option :option opt)
+                          (use-value (value) (process-option value))
+                          (skip-option ())))))))
       (let ((item (car tokens)))
         (cond ((and poption-name (argp item))
                (process-arg item))
-Original file line number
+Diff line change
@@ -1,4 +1,5 @@
     *.fas
     *.fasl
     *~
+    *.o
     \#*