Disallow SYMBOL, KEYWORD as flag types and disallow conjunctions (AND)

flag-test.lisp

@@ -39,12 +39,8 @@
 
 (test-define *null* nil "Always null" :type null)
 
-(test-define *keyword* nil "A keyword flag" :type (or null keyword))
-
 (test-define *member* :a "A member flag" :type (member nil :a :b :c))
 
-(test-define *implicit-keyword* :a "An implicit keyword flag.")
-
 (test-define *implicit-string* "string" "An implicit string flag.")
 
 (test-define *string* nil "A string flag." :type (or null string))
@@ -83,7 +79,7 @@ doc has embedded
 
 (test-define *mod* 10 "Modulo 10" :type (mod 16))
 
-(test-define *plus* 10 "Positive fixnum" :type (and fixnum unsigned-byte))
+;(test-define *plus* 10 "Positive fixnum" :type (and fixnum unsigned-byte))
 
 (test-define *some-flag* nil "A Flag that accepts inf, -inf, nan, or number."
   :type (or (member nil :inf :-inf :nan) number))
@@ -164,8 +160,6 @@ doc has embedded
 
   --implicit-integer Type: INTEGER Value: 10
 
-  --implicit-keyword [An implicit keyword flag.] Type: KEYWORD Value: :A
-
   --implicit-string [An implicit string flag.] Type: STRING Value: \"string\"
 
   -i
@@ -184,15 +178,6 @@ doc has embedded
 
   --intflag [no doc] Type: (INTEGER -10 10) Value: 10
 
-  -K
-  --key
-     [Short keyword flag]
-     Type: (OR NULL KEYWORD)
-
-  --keyword [A keyword flag] Type: (OR NULL KEYWORD)
-
-  --keyflag [no doc] Type: KEYWORD Value: :FOO
-
   --lorem-ipsum
      [Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod
       tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam,
@@ -231,8 +216,6 @@ doc has embedded
 
   --parsed-flag [A flag in hex.] Type: INTEGER Value: 0
 
-  --plus [Positive fixnum] Type: (AND FIXNUM UNSIGNED-BYTE) Value: 10
-
   --print-help-and-newlines
      [This
       doc has embedded
@@ -257,8 +240,6 @@ doc has embedded
 
   --stringflag [no doc] Type: STRING Value: \"foo\"
 
-  --symflag [no doc] Type: SYMBOL Value: :BAR
-
   --symbol-macro-flag Type: BOOLEAN
 
   --true [Test boolean flag.] Type: BOOLEAN Value: T
@@ -307,18 +288,6 @@ doc has embedded
   (with-flags-binding (:args '("--nointeger"))
     (expect (null *integer*))))
 
-(deftest test-keyword-flag ()
-  (multiple-value-bind (type result parsed-p consume-p)
-      (parse-variable '*keyword* "keyword")
-    (expect (equal type '(or null keyword)))
-    (expect (equal result :keyword))
-    (expect parsed-p)
-    (expect consume-p))
-
-  (with-flags-binding (:args '("--keyword" "keyword"))
-    (expect (eq *keyword* :keyword))))
-
-
 (deftest test-foo-flag ()
   (multiple-value-bind (type result parsed-p consume-p)
       (parse-variable '*foo* "F00")
@@ -336,9 +305,7 @@ doc has embedded
                                "--notrue"
                                "--nofalse"
                                "--null"    "null"
-                               "--keyword" "keyword"
                                "--member"  "a"
-                               "--implicit_keyword" "keyword"
                                "--implicit_string" "string"
                                "--string" "abc"
                                "--very_long_doc" "doc"
@@ -356,7 +323,6 @@ doc has embedded
                                "--double2" "-nan"
                                "--double3" "-inf"
                                "--mod" "5"
-                               "--plus" "2000"
                                "--some_flag" "nan"
                                "--a-named_flag" "100"
                                "--named_flag2" "200"
@@ -376,9 +342,7 @@ doc has embedded
     (expect (not *true*))
     (expect (not *false*))
     (expect (not *null*))
-    (expect (eq *keyword* :keyword))
     (expect (eq *member* :a))
-    (expect (eq *implicit-keyword* :keyword))
     (expect (equal *implicit-string* "string"))
     (expect (equal *string* "abc"))
     (expect (equal *very-long-doc* "doc"))
@@ -390,7 +354,6 @@ doc has embedded
     (expect (number:float-nan-p *double2*))
     (expect (= sb-ext:double-float-negative-infinity *double3*))
     (expect (= *mod* 5))
-    (expect (= *plus* 2000))
     (expect (eq *some-flag* :nan))
     (expect (= *named-flag* 100))
     (expect (= *named-flag2* 200))
@@ -405,9 +368,7 @@ doc has embedded
                                "--notrue"
                                "--nofalse"
                                "--null=null"
-                               "--keyword=keyword"
                                "--member=a"
-                               "--implicit_keyword=keyword"
                                "--implicit_string=string"
                                "--string=abc"
                                "--very_long_doc=doc"
@@ -425,7 +386,6 @@ doc has embedded
                                "--double2=-nan"
                                "--double3=-inf"
                                "--mod=5"
-                               "--plus=2000"
                                "--some_flag=nan"
 
                                "--a-named_flag=100"
@@ -446,9 +406,7 @@ doc has embedded
     (expect (not *true*))
     (expect (not *false*))
     (expect (not *null*))
-    (expect (eq *keyword* :keyword))
     (expect (eq *member* :a))
-    (expect (eq *implicit-keyword* :keyword))
     (expect (equal *implicit-string* "string"))
     (expect (equal *string* "abc"))
     (expect (equal *very-long-doc* "doc"))
@@ -460,7 +418,6 @@ doc has embedded
     (expect (number:float-nan-p *double2*))
     (expect (= sb-ext:double-float-negative-infinity *double3*))
     (expect (= *mod* 5))
-    (expect (= *plus* 2000))
     (expect (eq *some-flag* :nan))
     (expect (= *named-flag* 100))
     (expect (= *named-flag2* 200))
@@ -542,9 +499,7 @@ doc has embedded
   (test-wrong-value "--boolean" ":true")
   (test-wrong-value "--boolean2" "0")
   (test-wrong-value "--null"    "true")
-  (test-wrong-value "--keyword" "f:10")
   (test-wrong-value "--member"  "f")
-  (test-wrong-value "--implicit_keyword" "some:symbol")
   (test-wrong-value "--implicit_integer" "abc")
   (test-wrong-value "--integer" "0.0")
   (test-wrong-value "--number" ":test")
@@ -554,17 +509,14 @@ doc has embedded
   (test-wrong-value "--double2" "#xFFFF")
   (test-wrong-value "--double3" "nada")
   (test-wrong-value "--mod" "-10")
-  (test-wrong-value "--plus" "-2000")
   (test-wrong-value "--some_flag" "nano"))
 
 (defun test-missing-value (&rest args)
   (assert-error (flag:parse-command-line :args args :setp nil :normalize t)))
 
 (deftest test-missing-values ()
   (test-missing-value "--null")
-  (test-missing-value "--keyword")
   (test-missing-value "--member")
-  (test-missing-value "--implicit_keyword")
   (test-missing-value "--implicit_integer")
   (test-missing-value "--integer")
   (test-missing-value "--number")
@@ -573,22 +525,19 @@ doc has embedded
   (test-missing-value "--double2")
   (test-missing-value "--double3")
   (test-missing-value "--mod")
-  (test-missing-value "--plus")
   (test-missing-value "--some_flag"))
 
 (deftest invalid-names-test ()
-  (expect-macro-warning (flag:define *f* t "na" :name "an_underscore-and-hyphens" :type symbol))
-  (expect-macro-warning (flag:define *f* t "na" :name "3rror" :type symbol))
-  (expect-macro-warning (flag:define *f* t "na" :names ("a-dash" "3rror") :type symbol))
-  (expect-macro-warning (flag:define *.* t "na" :type symbol))
-  (expect-macro-warning (flag:define *f.* t "na" :type symbol))
-  (expect-macro-warning (flag:define *funny/flag* t "na" :type symbol)))
+  (expect-macro-warning (flag:define *f* t "na" :name "an_underscore-and-hyphens" :type integer))
+  (expect-macro-warning (flag:define *f* t "na" :name "3rror" :type integer))
+  (expect-macro-warning (flag:define *f* t "na" :names ("a-dash" "3rror") :type integer))
+  (expect-macro-warning (flag:define *.* t "na" :type integer))
+  (expect-macro-warning (flag:define *f.* t "na" :type integer))
+  (expect-macro-warning (flag:define *funny/flag* t "na" :type integer)))
 
 
 (test-define *boo* t "Short test boolean flag." :names ("boo" "B"))
 
-(test-define *key* nil "Short keyword flag" :type (or null keyword) :names ("key" "K"))
-
 (test-define *mem* :a "Short member flag" :type (member nil :a :b :c) :names ("mem" "M"))
 
 (test-define *int* 10 "An short int flag" :type (or (integer -100 100) null) :names ("int" "i"))
@@ -600,14 +549,12 @@ doc has embedded
 
 (deftest test-short-flags ()
   (with-flags-binding (:args '("-B=false"
-                               "-K" "kEy"
                                "-M" "B"
                                "-i=11"
                                "-I" "22"
                                "-f" "0.0"
                                "-S" "str"))
     (expect (null *boo*))
-    (expect (eq *key* :key))
     (expect (eq *mem* :B))
     (expect (= *int* 11))
     (expect (= *int2* 22))
@@ -687,33 +634,6 @@ doc has embedded
     (expect-error (parse-command-line* '("--noboolflag" "true")))
     (expect-error (parse-command-line* '("--noboolflag" "false")))))
 
-(test-define *keyword-flag* :foo "no doc" :name "keyflag" :type keyword)
-
-(deftest keyword-flag ()
-  (expect (eq *keyword-flag* :foo))
-  (let ((*keyword-flag* *keyword-flag*))
-    (parse-command-line* '("--keyflag" "dog"))
-    (expect (eq *keyword-flag* :dog))
-    (parse-command-line* '("--keyflag=cat"))
-    (expect (eq *keyword-flag* :cat))
-    (parse-command-line* '("--keyflag="))
-    (expect (eq *keyword-flag* :||))))
-
-(test-define *symbol-flag* :bar "no doc" :name "symflag" :type symbol)
-
-(deftest symbol-flag ()
-  (expect (eq *symbol-flag* :bar))
-  (let ((*symbol-flag* *symbol-flag*))
-    (parse-command-line* '("--symflag" "ace.flag:define"))
-    (expect (eq *symbol-flag* 'ace.flag:define))
-    (parse-command-line* '("--symflag=ace.flag-test::unexported-symbol"))
-    (expect (eq *symbol-flag* 'unexported-symbol))
-    (expect-error (parse-command-line* '("--symflag=")))
-    (expect-error (parse-command-line* '("--symflag" ":bad-colons")))
-    (expect-error (parse-command-line* '("--symflag" "more:bad:colons")))
-    (expect-error (parse-command-line* '("--symflag" "bad-package:foo")))
-    (expect-error (flag:parse-command-line :args '("--symflag")))))
-
 (test-define *string-flag* "foo" "no doc" :name "stringflag" :type string)
 
 (deftest string-flag ()
@@ -786,21 +706,14 @@ doc has embedded
     (expect-error (parse-command-line* '("--color=orange")))))
 
 (deftest syntax-errors ()
-  (expect-macro-warning (flag:define *s* t "na" :name s :type symbol))
-  (expect-macro-warning (flag:define *s* t "na" :name "" :type symbol))
-  (expect-macro-warning (flag:define *s* t "na" :name "s" :type "symbol"))
-  (expect-macro-error (flag:define *s* t "na" :name "s" :type symbol :help h))
-  (expect-macro-warning (flag:define *s* t "na" :name "s" :type symbol :parser "p"))
-  (expect-macro-warning (flag:define *s* t 'd :name "s" :type symbol))
   (expect-macro-warning (flag:define *s* t "na" :name "s" :type vector)))
 
 (test-define *no-go* nil "no doc" :name "nogo" :type boolean)
 (test-define *rth* nil "no doc" :name "rth" :type boolean)
 
 (deftest boolean-semantic-errors ()
   (expect-error (flag:define *b* nil "na" :name "boolflag" :type boolean))
-  (expect-error (flag:define *go* nil "na" :name "go" :type boolean))
-  (expect-error (flag:define *north* nil "na" :name "north" :type symbol)))
+  (expect-error (flag:define *go* nil "na" :name "go" :type boolean)))
 
 (defvar *symbol-flag* nil)
 

flag.lisp

@@ -130,6 +130,12 @@
       (fail "The flag ~S requires a help string." doc))
     (unless type
       (fail "Flag definition ~S lacks a :TYPE" flag))
+    (labels ((treefind (elt tree)
+               (cond ((atom tree) (eq elt tree))
+                     (t (or (treefind elt (car tree)) (treefind elt (cdr tree)))))))
+      (let ((expansion (sb-ext:typexpand type)))
+        (when (or (treefind 'keyword expansion) (treefind 'symbol expansion))
+          (error "Don't parse flag ~S as a symbol. Use string instead" flag))))
     (unless (typep type '(or symbol cons))
       (fail "The type of flag ~S needs to be a proper type specifier. Provided: ~S." flag type))
     (dolist (name names)

parse-test.lisp

@@ -73,28 +73,6 @@
   (test-not-parsed 'null "YES")
   (test-not-parsed 'null "What-ever"))
 
-(deftest test-parse-type-keyword ()
-  (test-parse-type 'keyword ":keyword" :keyword)
-  (test-parse-type 'keyword "true" :true)
-  (test-parse-type 'keyword "False" :false)
-  (test-parse-type 'keyword "1" :1)
-  (test-parse-type 'keyword "-1" :-1)
-  (test-parse-type 'keyword "nil" :nil)
-  (test-parse-type 'keyword "t" :t))
-
-(deftest test-parse-type-symbol ()
-  (test-parse-type 'symbol "ace.flag.parse-test:test-parse-type" 'test-parse-type)
-  (test-parse-type 'symbol "ace.flag.parse-test::test-parse-type" 'test-parse-type)
-  (test-parse-type 'symbol ":test-parse-type" :test-parse-type)
-
-  (test-not-parsed 'symbol "test:::test-parse-type")
-  (test-not-parsed 'symbol "test-parse-type")
-  (test-not-parsed 'symbol "::test-parse-type")
-  (test-not-parsed 'symbol ":::test-parse-type")
-  (test-not-parsed 'symbol "t")
-  (test-not-parsed 'symbol "nil")
-  (test-not-parsed 'symbol "0"))
-
 (deftest test-parse-type-string ()
   (test-parse-type 'string "" "")
   (test-parse-type 'string "A" "A")
@@ -223,22 +201,18 @@
 
 (deftest test-parse-type-or ()
   (test-parse-type '(or number boolean) "true" t)
-  (test-parse-type '(or boolean keyword) "yes" t)
   (test-parse-type '(or single-float boolean) "t" t)
 
   (test-parse-type '(or integer boolean) "True" t)
   (test-parse-type '(or fixnum boolean) "YES" t)
   (test-parse-type '(or null boolean) "T" t)
 
   (test-parse-type '(or number string) "True" "True")
-  (test-parse-type '(or number keyword) "YES" :YES)
 
   (test-parse-type '(or boolean boolean) "nil" nil)
   (test-parse-type '(or null boolean) "no" nil)
 
   (test-parse-type '(or null double-float) "nan" double-float-not-a-number)
 
-  (test-parse-type '(or boolean keyword) "Null" nil)
-  (test-parse-type '(or number boolean) "NIL" nil)
-  (test-parse-type '(or symbol boolean) "NO" nil))
+  (test-parse-type '(or number boolean) "NIL" nil))
 

parse.lisp

@@ -99,13 +99,8 @@ The TYPE-SELECTOR is the type-specifier itself or the car of the type-specifier.
         (return (values parsed-value t))))))
 
 (defmethod type ((type-selector (eql 'and)) (value string) &key specifier top)
-  ; Parses an and type. Iterates through the subtypes.
-  (assert specifier)
-  (dolist (sub-type (rest specifier))
-    (multiple-value-bind (parsed-value parsed-p)
-        (type (type-selector sub-type) value :specifier sub-type :top (or top specifier))
-      (when (and parsed-p (typep parsed-value (or top specifier)))
-        (return (values parsed-value t))))))
+  (declare (ignore specifier top))
+  (error "Unreachable: AND"))
 
 (defmethod type ((type-selector (eql 'member)) (value string) &key specifier top)
   ; Parses a member specifier. Iterates through members. Compares by equalp.
@@ -134,30 +129,10 @@ The TYPE-SELECTOR is the type-specifier itself or the car of the type-specifier.
   (values value (and value t)))
 
 (defmethod type ((type-selector (eql 'keyword)) (value string) &key)
-  ; Interns the value into the keyword package.
-  (let ((colon (position #\: value :test #'char=)))
-    (cond ((null colon)
-           (values (intern (string-upcase value) (find-package "KEYWORD")) t))
-          ((= colon 0)
-           (unless (find #\: value :test #'char= :start 1)
-             (type 'keyword (subseq value 1))))
-          (t
-           (values nil nil)))))
+  (error "Unreachable: KEYWORD"))
 
 (defmethod type ((type-selector (eql 'symbol)) (value string) &key)
-  ; Parses a symbol that is prefixed with the package.
-  (let* ((full-name (string-trim " " (string-upcase value)))
-         (pos (position #\: full-name :from-end t))
-         (package-name
-           (when (and pos (plusp pos))
-             (subseq full-name 0 (if (char= (char full-name (1- pos)) #\:) (1- pos) pos))))
-         (package (and package-name (find-package package-name)))
-         (symbol-name (and pos (subseq full-name (1+ pos))))
-         (symbol (cond (package
-                        (find-symbol symbol-name package))
-                       ((eql pos 0)
-                        (find-symbol symbol-name (find-package "KEYWORD"))))))
-    (values symbol (and symbol t))))
+  (error "Unreachable: SYMBOL"))
 
 (defmethod type ((type-selector (eql 'number)) (value string) &key)
   ; Parses a number.