r7818: add argument processing using #\=, big refactoring, more tests added and passed

diff --git a/getopt.lisp b/getopt.lisp
index 93f65b645e4cdf8023c5a43efcd13aff92692b76..48ec91be9a17d362e0dbdb66a26f0e8e6973a961 100644 (file)
--- a/getopt.lisp
+++ b/getopt.lisp
@@ -20,7 +20,7 @@
 
 
 (defun is-short-option (arg)
-  (and (= 2 (length arg))
+  (and (>= (length arg) 2)
        (char= #\- (schar arg 0))
        (char/= #\- (schar arg 1))))
 
@@ -35,24 +35,32 @@
        (char= #\- (schar arg 1))
        (char/= #\- (schar arg 3))))
 
-(defun arg->base-name (arg)
-  (cond
-   ((is-long-option arg)
-    (subseq arg 2))
-   ((is-short-option arg)
-    (subseq arg 1))
-   (t
-    arg)))
-  
+(defun arg->base-name (arg option-type)
+  "returns base-name,argument"
+  (let ((start (ecase option-type
+                (:long 2)
+                (:short 1)))
+       (name-end (position #\= arg)))
+
+    (values (subseq arg start name-end)
+           (when name-end (subseq arg (1+ name-end))))))
+
+(defun analyze-arg (arg)
+  "Analyzes an argument. Returns option-type,base-name,argument"
+  (let* ((option-type (cond ((is-short-option arg) :short)
+                           ((is-long-option arg) :long)
+                           (t :arg))))
+    (if (or (eq option-type :short) (eq option-type :long))
+       (multiple-value-bind (base arg) (arg->base-name arg option-type)
+         (values option-type base arg))
+       (values :arg arg nil))))
+
+    
 (defun match-option (arg options)
-  "Matches an argument to an option. Returns match,is-long"
-  (cond
-    ((is-long-option arg)
-     (values (find (subseq arg 2) options :key #'car :test #'equal) :long))
-    ((is-short-option arg)
-     (values (find (subseq arg 1) options :key #'car :test #'equal) :short))
-    (t
-     (values nil nil))))
+  "Matches an argument to an option. Returns option-list,option-type,base-name,argument"
+  (multiple-value-bind (option-type base-name argument) (analyze-arg arg)
+    (let ((match (find base-name options :key #'car :test #'equal)))
+      (values match option-type base-name argument))))
 
 (defun getopt (args options)
   "Processes a list of arguments and options. Returns filtered argument
@@ -74,13 +82,29 @@ opts is a list of option lists. The fields of the list are
      ((is-option-terminator (car pos))
       (setq finished-options t))
      (t
-      (multiple-value-bind (match is-long) (match-option (car pos) options)
-       (if match
-           (cond 
-            ((and (eq :required (second match)) (null (cdr pos)))
-             (push  (arg->base-name (car pos)) errors))
-            (t
-             (push (cons (arg->base-name (car pos)) (second pos)) out-opts)
-             (setq pos (cdr pos))))
-         (push (car pos) out-args)))))))
+      (let ((arg (car pos)))
+       (multiple-value-bind (option-list option-type base-name argument)
+           (match-option (car pos) options)
+         (cond
+           (option-list
+            (cond
+              (argument
+               (case (second option-list)
+                 (:none
+                  (push base-name errors))
+                 (t
+                  (push (cons base-name argument) out-opts))))
+              ((null argument)
+               (if (and (eq :required (second option-list)) (null (cdr pos)))
+                   (push base-name errors)
+                   (if (or (is-short-option (second pos))
+                           (is-long-option (second pos)))
+                       (if (eq :required (second option-list))
+                           (push base-name errors)
+                           (push (cons base-name (third option-list)) out-args))
+                       (progn
+                         (push (cons base-name (second pos)) out-opts)
+                         (setq pos (cdr pos))))))))
+           (t
+            (push arg out-args)))))))))
 

diff --git a/tests.lisp b/tests.lisp
index 182bddfd4a4d634954bea86522ae3351bc77aa7f..08a205da30691231b29a0c7be677f9d796e8502a 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -195,7 +195,11 @@
 (deftest gopt.7 (getopt '("ab" "--colon" "val" "--" "-c") '(("colon" :optional) ("-c" :none))) ("ab" "-c") (("colon" . "val")) nil)
 (deftest gopt.8 (getopt '("argv" "-c" "cd") '(("c" :required))) ("argv") (("c" . "cd")) nil)
 (deftest gopt.9 (getopt '("argv" "-c") '(("c" :required))) ("argv") nil ("c"))
-
+(deftest gopt.10 (getopt '("argv" "-c=10") '(("c" :required))) ("argv") (("c" . "10")) nil)
+(deftest gopt.11 (getopt '("argv" "-c=10") '(("c" :none))) ("argv") nil ("c"))
+(deftest gopt.12 (getopt '("--along=10") '(("along" :optional))) nil (("along" . "10")) nil)
+(deftest gopt.13 (getopt '("--along=10") '(("along" :none))) nil nil ("along")) 
+  
 ;;; MOP Testing
 
 (eval-when (:compile-toplevel :load-toplevel :execute)