From 4c4be239432fb022309c9bdffa3ad86eb3a5c536 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 31 Aug 2007 18:04:31 +0000 Subject: [PATCH] r11859: Canonicalize whitespace --- main.lisp | 92 +++++++++++++++++++++++++++--------------------------- tests.lisp | 56 ++++++++++++++++----------------- 2 files changed, 74 insertions(+), 74 deletions(-) diff --git a/main.lisp b/main.lisp index b6b5070..311b73b 100644 --- a/main.lisp +++ b/main.lisp @@ -33,28 +33,28 @@ (defun decompose-arg (arg option-type) "Returns base-name,argument" (let ((start (ecase option-type - (:long 2) - (:short 1))) - (name-end (position #\= arg))) + (:long 2) + (:short 1))) + (name-end (position #\= arg))) (values (subseq arg start name-end) - (when name-end (subseq arg (1+ 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)))) + ((is-long-option arg) :long) + (t :arg)))) (if (or (eq option-type :short) (eq option-type :long)) - (multiple-value-bind (base arg) (decompose-arg arg option-type) - (values option-type base arg)) - (values :arg arg nil)))) + (multiple-value-bind (base arg) (decompose-arg arg option-type) + (values option-type base arg)) + (values :arg arg nil)))) (defun find-option (name options) "Find an option in option list. Handles using unique abbreviations" (let* ((option-names (mapcar #'car options)) - (pos (match-unique-abbreviation name option-names))) + (pos (match-unique-abbreviation name option-names))) (when pos (nth pos options)))) @@ -71,17 +71,17 @@ "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation. Returns NIL if no match found." (let ((len (length abbr)) - (matches nil)) + (matches nil)) (dotimes (i (length strings)) (let* ((s (nth i strings)) - (l (length s))) - (cond - ((= len l) - (when (string= abbr s) - (push (cons s i) matches))) - ((< len l) - (when (string= abbr (subseq s 0 len)) - (push (cons s i) matches)))))) + (l (length s))) + (cond + ((= len l) + (when (string= abbr s) + (push (cons s i) matches))) + ((< len l) + (when (string= abbr (subseq s 0 len)) + (push (cons s i) matches)))))) (when (= 1 (length matches)) (cdr (first matches))))) @@ -106,31 +106,31 @@ opts is a list of option lists. The fields of the list are (setq finished-options t)) (t (let ((arg (car pos))) - (multiple-value-bind (option-list option-type base-name argument) - (match-option (car pos) options) - (cond - ((and option-list (not (eq option-type :arg))) - (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 - (if (or (eq :long option-type) - (eq :short option-type)) - (push (nth-value 0 (decompose-arg arg option-type)) errors) - (push arg out-args)))))))))) + (multiple-value-bind (option-list option-type base-name argument) + (match-option (car pos) options) + (cond + ((and option-list (not (eq option-type :arg))) + (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 + (if (or (eq :long option-type) + (eq :short option-type)) + (push (nth-value 0 (decompose-arg arg option-type)) errors) + (push arg out-args)))))))))) diff --git a/tests.lisp b/tests.lisp index 5790baa..f8f6574 100644 --- a/tests.lisp +++ b/tests.lisp @@ -24,7 +24,7 @@ (defun do-tests () (with-tests (:name "GETOPT") (let ((*break-on-test-failures* nil)) - + ;; match-unique-abbreviation (test nil (match-unique-abbreviation "abc" nil)) (test nil (match-unique-abbreviation "abc" '("ab"))) @@ -34,38 +34,38 @@ (test nil (match-unique-abbreviation "ab" '("ab" "abc"))) (test 1 (match-unique-abbreviation "ac" '("ab" "ac"))) (test 1 (match-unique-abbreviation "ac" '("ab" "acb"))) - + ;; getopt (test-mv '(("argv") nil nil) (getopt '("argv") nil)) (test-mv '(("argv" "2") nil nil) (getopt '("argv" "2") nil)) - + (test-mv '(("argv") (("c")) nil) (getopt '("argv" "-c") '(("c" :none)))) - - (test-mv '(("argv") (("c" . "val")) nil) - (getopt '("argv" "-c" "val") '(("c" :optional)))) - (test-mv '(("argv" "v1") (("c" . "val")) nil) - (getopt '("argv" "-c" "val" "v1") '(("c" :optional)))) - (test-mv '(( "v1") (("colon" . "val")) nil) - (getopt '("--colon" "val" "v1") '(("colon" :optional)))) - (test-mv '(("ab" "-c") (("colon" . "val")) nil) - (getopt '("ab" "--colon" "val" "--" "-c") - '(("colon" :optional) ("-c" :none)))) - (test-mv '(("argv") (("c" . "cd")) nil) - (getopt '("argv" "-c" "cd") '(("c" :required)))) - (test-mv '(("argv") nil ("c")) - (getopt '("argv" "-c") '(("c" :required)))) - (test-mv '(("argv") (("c" . "10")) nil) - (getopt '("argv" "-c=10") '(("c" :required)))) - (test-mv '(("argv") nil ("c")) - (getopt '("argv" "-c=10") '(("c" :none)))) - (test-mv '(nil (("along" . "10")) nil) - (getopt '("--along=10") '(("along" :optional)))) - (test-mv '(nil nil ("along")) - (getopt '("--along=10") '(("along" :none)))) - (test-mv '(nil (("along" . "10")) nil) - (getopt '("--a=10") '(("along" :optional)))) + + (test-mv '(("argv") (("c" . "val")) nil) + (getopt '("argv" "-c" "val") '(("c" :optional)))) + (test-mv '(("argv" "v1") (("c" . "val")) nil) + (getopt '("argv" "-c" "val" "v1") '(("c" :optional)))) + (test-mv '(( "v1") (("colon" . "val")) nil) + (getopt '("--colon" "val" "v1") '(("colon" :optional)))) + (test-mv '(("ab" "-c") (("colon" . "val")) nil) + (getopt '("ab" "--colon" "val" "--" "-c") + '(("colon" :optional) ("-c" :none)))) + (test-mv '(("argv") (("c" . "cd")) nil) + (getopt '("argv" "-c" "cd") '(("c" :required)))) + (test-mv '(("argv") nil ("c")) + (getopt '("argv" "-c") '(("c" :required)))) + (test-mv '(("argv") (("c" . "10")) nil) + (getopt '("argv" "-c=10") '(("c" :required)))) + (test-mv '(("argv") nil ("c")) + (getopt '("argv" "-c=10") '(("c" :none)))) + (test-mv '(nil (("along" . "10")) nil) + (getopt '("--along=10") '(("along" :optional)))) + (test-mv '(nil nil ("along")) + (getopt '("--along=10") '(("along" :none)))) + (test-mv '(nil (("along" . "10")) nil) + (getopt '("--a=10") '(("along" :optional)))) (test-mv '(nil nil ("a")) - (getopt '("--a=10") '(("along" :optional) ("aboot" :optional)))) + (getopt '("--a=10") '(("along" :optional) ("aboot" :optional)))) (test-mv '(("a") nil nil) (getopt '("a") '(("a" :none)))) )) -- 2.34.1