diff --git a/.gitignore b/.gitignore index d0f1392..323c1b5 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ *.fas *.fasl *~ +*.o \#* diff --git a/.travis.yml b/.travis.yml index f33e50a..e4bd1a9 100644 --- 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,6 +21,11 @@ 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 @@ -20,7 +33,7 @@ install: 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 index 9f7f7a3..7f6ec28 100644 --- 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 index 166552b..77a3823 100644 --- 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 index 0d07de1..7cc9544 100644 --- 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))