diff --git a/.gitignore b/.gitignore
index 1e9a86e..328b5b3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,7 @@
+/.idea
target
codox
+.DS_Store
*.jar
*.class
.lein*
@@ -7,3 +9,6 @@ codox
\#*
.project
.classpath
+
+/resources
+/out
\ No newline at end of file
diff --git a/project.clj b/project.clj
index 4c8a69e..abe8a2a 100644
--- a/project.clj
+++ b/project.clj
@@ -3,11 +3,23 @@
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
:url "https://github.com/blancas/kern"
- :dependencies [[org.clojure/clojure "1.8.0"]]
+ :dependencies [[org.clojure/clojure "1.8.0"]
+ [org.clojure/clojurescript "1.9.854"]]
:source-paths ["src/main/clojure"]
:test-paths ["src/test/clojure"]
:jvm-opts ["-Dfile.encoding=UTF-8"]
:deploy-repositories [["releases" :clojars]]
+ :cljsbuild {:builds {:dev {:source-paths ["src/main/clojure" "src/test/clojure"]
+ :compiler {:main blancas.kern.core
+ :optimizations :none
+ :asset-path "js/out"
+ :output-to "resources/public/js/dev.js"
+ :output-dir "resources/public/js/out"}
+ :figwheel true}
+ :test {:source-paths ["src/main/clojure" "src/test/clojure"]
+ :compiler {:output-to "out/testable.js"
+ :main blancas.kern.runnner
+ :optimizations :none}}}}
:profiles
{:1.3 {:dependencies [[org.clojure/clojure "1.3.0"]]}
:1.4 {:dependencies [[org.clojure/clojure "1.4.0"]]}
@@ -20,8 +32,14 @@
[org.clojure/tools.macro "0.1.2"]
[org.clojure/tools.trace "0.7.9"]
[org.clojure/tools.nrepl "0.2.11"]
- [midje "1.8.3" :exclusions [org.clojure/clojure]]
+ [bultitude "0.2.6"] [org.clojure/core.match "0.3.0-alpha5"]
[criterium "0.4.4"]
- [jline "1.0"]]
- :plugins [[codox "0.9.4"][lein-midje "3.2"]]
- :codox {:source-paths ["src/main/clojure"] :output-path "codox"}}})
+ [jline "1.0"]
+ [doo "0.1.7"]]
+ :plugins [[codox "0.9.4"]
+ [lein-doo "0.1.7"]
+ [lein-figwheel "0.5.12"]]
+ :codox {:source-paths ["src/main/clojure"] :output-path "codox"}
+ :doo {:build "test"
+ :alias {:browsers [:chrome :firefox]
+ :all [:browsers :headless]}}}})
diff --git a/src/main/clojure/blancas/kern/char.clj b/src/main/clojure/blancas/kern/char.clj
new file mode 100644
index 0000000..659acfb
--- /dev/null
+++ b/src/main/clojure/blancas/kern/char.clj
@@ -0,0 +1,38 @@
+(ns blancas.kern.char)
+
+(defn is-letter [^Character c]
+ (Character/isLetter c))
+
+
+(defn is-lower-case [^Character c]
+ (Character/isLowerCase c))
+
+
+(defn is-upper-case [^Character c]
+ (Character/isUpperCase c))
+
+
+(defn is-white-space [^Character c]
+ (Character/isWhitespace c))
+
+
+(defn is-space [^Character c]
+ (.equals c \space))
+
+
+(defn is-space [^Character c]
+ (.equals c \space))
+
+
+(defn is-tab [^Character c]
+ (.equals c \tab))
+
+
+(defn is-digit [^Character c]
+ (Character/isDigit c))
+
+(defn is-letter-or-digit [^Character c]
+ (Character/isLetterOrDigit c))
+
+(defn upper-case [^Character c]
+ (Character/toUpperCase c))
\ No newline at end of file
diff --git a/src/main/clojure/blancas/kern/char.cljs b/src/main/clojure/blancas/kern/char.cljs
new file mode 100644
index 0000000..7a33077
--- /dev/null
+++ b/src/main/clojure/blancas/kern/char.cljs
@@ -0,0 +1,35 @@
+(ns blancas.kern.char
+ (:require [clojure.string :as str]))
+
+(defn is-letter [c]
+ (re-find #"^[a-zA-Z]$" c))
+
+
+(defn is-lower-case [c]
+ (re-find #"^[a-z]$" c))
+
+
+(defn is-upper-case [c]
+ (re-find #"^[A-Z]$" c))
+
+
+(defn is-white-space [c]
+ (re-find #"^\s$" c))
+
+
+(defn is-space [c]
+ (= c \space))
+
+
+(defn is-tab [c]
+ (= c \tab))
+
+
+(defn is-digit [c]
+ (re-find #"^[0-9]$" c))
+
+
+(defn is-letter-or-digit [c]
+ (re-find #"^[a-zA-Z0-9]$" c))
+
+(defn upper-case [c] (str/upper-case c))
\ No newline at end of file
diff --git a/src/main/clojure/blancas/kern/core.clj b/src/main/clojure/blancas/kern/core.cljc
similarity index 74%
rename from src/main/clojure/blancas/kern/core.clj
rename to src/main/clojure/blancas/kern/core.cljc
index 72f2991..11164d4 100644
--- a/src/main/clojure/blancas/kern/core.clj
+++ b/src/main/clojure/blancas/kern/core.cljc
@@ -6,7 +6,8 @@
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
-(ns ^{:doc "The core Kern library.
+(ns
+ ^{:doc "The core Kern library.
Kern is a library of parser combinators for Clojure. It is useful for
implementing recursive-descent parsers based on predictive LL(1) grammars
@@ -28,49 +29,46 @@ http://eprints.nottingham.ac.uk/237/1/monparsing.pdf
William H. Burge
Recursive Programming Techniques
Addison-Wesley, 1975"
- :author "Armando Blancas"}
+ :author "Armando Blancas"}
blancas.kern.core
(:refer-clojure :exclude [cat])
- (:require [blancas.kern.i18n :refer :all]
- [clojure.string :refer [join]]
- [clojure.java.io :refer [reader]]
+ (:require [blancas.kern.i18n :refer [fmt i18n di18n]]
+ [blancas.kern.char :as char]
+ [clojure.string :refer [join] :as str]
[clojure.pprint :refer [pprint]]))
-(defmacro def-
- "Same as def, yielding a private def."
- [name & more]
- (list* `def (with-meta name (assoc (meta name) :private true)) more))
-
-
(defmacro defn*
"Same as def, yielding a dynamic def."
[name & more]
(list* `defn (with-meta name (assoc (meta name) :dynamic true)) more))
-(defmacro fwd
- "Delays the evaluation of a parser that was forward (declare)d and
- it has not been defined yet. For use in (def)s of no-arg parsers,
- since the parser expression evaluates immediately."
- [p]
- (let [x (gensym)]
- `(fn [~x] (~p ~x))))
+#?(:clj
+ (defmacro fwd
+ "Delays the evaluation of a parser that was forward (declare)d and
+it has not been defined yet. For use in (def)s of no-arg parsers,
+since the parser expression evaluates immediately."
+ [p]
+ (let [x (gensym)]
+ `(fn [~x] (~p ~x)))))
-(defn char-seq
- "Returns characters from rdr as a lazy sequence.
- rdr must implement java.io.Reader"
- [^java.io.Reader rdr]
- (let [c (.read rdr)]
- (when-not (neg? c)
- (cons (char c) (lazy-seq (char-seq rdr))))))
+#?(:clj
+ (defn char-seq
+ "Returns characters from rdr as a lazy sequence.
+ rdr must implement java.io.Reader"
+ [^java.io.Reader rdr]
+ (let [c (.read rdr)]
+ (when-not (neg? c)
+ (cons (char c) (lazy-seq (char-seq rdr)))))))
-(defn f->s
- "Gets a character sequence from a file-like object."
- ([f] (slurp f))
- ([f e] (slurp f :encoding e)))
+#?(:clj
+ (defn f->s
+ "Gets a character sequence from a file-like object."
+ ([f] (slurp f))
+ ([f e] (slurp f :encoding e))))
(defn member?
@@ -95,22 +93,22 @@ Addison-Wesley, 1975"
;; Error types.
-(def- err-system 0) ;; Used in satisfy for specific unexpected input.
-(def- err-unexpect 1) ;; Used on any unexpected input to show a message.
-(def- err-expect 2) ;; Used to show a message of what's expected.
-(def- err-message 3) ;; Used for any kind of message from client code.
+(def err-system 0) ;; Used in satisfy for specific unexpected input.
+(def err-unexpect 1) ;; Used on any unexpected input to show a message.
+(def err-expect 2) ;; Used to show a message of what's expected.
+(def err-message 3) ;; Used for any kind of message from client code.
;; Keeps the position of the input:
;; src - a string that identifies the source of input
;; line - the line into the input stream.
;; col - the column into the line.
(defrecord PPosition [src line col]
- Comparable
- (compareTo [this other]
- (let [result (compare line (:line other))]
- (if (zero? result)
- (compare col (:col other))
- result))))
+ #?(:clj Comparable :cljs IComparable)
+ (#?(:clj compareTo :cljs -compare) [this other]
+ (let [result (compare line (:line other))]
+ (if (zero? result)
+ (compare col (:col other))
+ result))))
;; A PMessage consists of:
;; type - One of the error types listed above.
@@ -133,67 +131,67 @@ Addison-Wesley, 1975"
(defrecord PState [input pos value ok empty user error])
-(defn- make-pos
+(defn make-pos
"Makes a position record."
([src] (make-pos src 1 1))
([src ln col] (->PPosition (or src "") ln col)))
-(defn- ^:dynamic char-pos
+(defn ^:dynamic char-pos
"Computes the new position of the character c."
[pos c]
(cond (= c \newline) (assoc pos :col 1 :line (inc (:line pos)))
- (= c \tab) (assoc pos :col (+ (:col pos) *tab-width*))
- :else (assoc pos :col (inc (:col pos)))))
+ (= c \tab) (assoc pos :col (+ (:col pos) *tab-width*))
+ :else (assoc pos :col (inc (:col pos)))))
-(defn- ^:dynamic str-pos
+(defn ^:dynamic str-pos
"Computes the stream position after the character sequence cs."
[pos cs] (if (empty? cs) pos (recur (char-pos pos (first cs)) (rest cs))))
-(defn- make-err-system
+(defn make-err-system
"Makes a message of type err-system."
[pos text] (->PError pos (list (->PMessage err-system text))))
-(defn- make-err-unexpect
+(defn make-err-unexpect
"Makes a message of type err-unexpect."
[pos text] (->PError pos (list (->PMessage err-unexpect text))))
-(defn- make-err-expect
+(defn make-err-expect
"Makes a message of type err-expect."
[pos text] (->PError pos (list (->PMessage err-expect text))))
-(defn- make-err-message
+(defn make-err-message
"Makes a message of type err-message."
[pos text] (->PError pos (list (->PMessage err-message text))))
-(defn- get-msg
+(defn get-msg
"Get the text from message types system, unexpect, and message."
[pmsg]
(let [type (:type pmsg)
- text (-> pmsg :text force)]
- (cond (= type err-system) (fmt :unexpected text)
- (= type err-unexpect) (fmt :unexpected text)
- (= type err-message) text)))
+ text (-> pmsg :text force)]
+ (cond (= type err-system) (fmt :unexpected text)
+ (= type err-unexpect) (fmt :unexpected text)
+ (= type err-message) text)))
-(defn- get-msg-expect
+(defn get-msg-expect
"Get the text from a list of messages of type expect."
[lst]
(let [show (fn [xs]
- (let [comma-sep (join (i18n :comma) (butlast xs))
- or-last (fmt :or (last xs))]
- (str comma-sep or-last)))
- opts (map (comp force :text) lst)
- cnt (count opts)]
+ (let [comma-sep (join (i18n :comma) (butlast xs))
+ or-last (fmt :or (last xs))]
+ (str comma-sep or-last)))
+ opts (map (comp force :text) lst)
+ cnt (count opts)]
(fmt :expecting (if (= cnt 1) (first opts) (show opts)))))
-
+
(defn- get-msg-list
"Gets the text of error messages as a list."
[{msgs :msgs}]
@@ -209,10 +207,10 @@ Addison-Wesley, 1975"
(reduce #(conj %1 (get-msg %2)) [] lst)))))
-(defn- get-msg-str
+(defn get-msg-str
"Gets the text of error messages separated by \\n."
[err]
- (let [eol (System/getProperty "line.separator")]
+ (let [eol #?(:clj (System/getProperty "line.separator") :cljs "\n")]
(join eol (get-msg-list err))))
@@ -220,12 +218,13 @@ Addison-Wesley, 1975"
"Merges errors from two state records."
[{e1 :error} {e2 :error}]
(cond (and (nil? e1) (nil? e2)) nil
- (nil? e1) e2
- (nil? e2) e1
- :else (let [r (compare (:pos e1) (:pos e2))]
- (cond (zero? r) (update-in e1 [:msgs] concat (:msgs e2))
- (pos? r) e1
- :else e2))))
+ (nil? e1) e2
+ (nil? e2) e1
+ :else (let [pos1 (:pos e1) pos2 (:pos e2)
+ r (compare [(:line pos1) (:col pos1)] [(:line pos2) (:col pos2)])]
+ (cond (zero? r) (update-in e1 [:msgs] concat (:msgs e2))
+ (pos? r) e1
+ :else e2))))
(defn- cat
@@ -241,12 +240,12 @@ Addison-Wesley, 1975"
"Replace expect errors with expecting msg."
[msg s]
(letfn [(not-ex [{type :type}]
- (not (= type err-expect)))
- (update [lst err]
- (cons err (filter not-ex lst)))]
+ (not (= type err-expect)))
+ (update [lst err]
+ (cons err (filter not-ex lst)))]
(let [m (->PMessage err-expect msg)]
(update-in s [:error :msgs] update m))))
-
+
;; +-------------------------------------------------------------+
;; | Public supporting functions. |
@@ -318,10 +317,10 @@ Addison-Wesley, 1975"
(let [stm (:input s)]
(if (empty? stm)
(unexpected (i18n :eof) s)
- (let [c (first stm)]
- (if (pred c)
- (->PState (rest stm) (char-pos (:pos s) c) c true false (:user s) nil)
- (unexpected-input (with-out-str (pr c)) s)))))))
+ (let [c (first stm)]
+ (if (pred c)
+ (->PState (rest stm) (char-pos (:pos s) c) c true false (:user s) nil)
+ (unexpected-input (with-out-str (pr c)) s)))))))
;; +-------------------------------------------------------------+
@@ -359,9 +358,9 @@ Addison-Wesley, 1975"
(let [s2 (p s)]
(if (failed-empty? s2)
(let [s3 (q s)]
- (if (:ok s3)
- s3
- (assoc s3 :error (merge-err s2 s3))))
+ (if (:ok s3)
+ s3
+ (assoc s3 :error (merge-err s2 s3))))
s2))))
([p q & more]
(reduce <|> (list* p q more))))
@@ -376,16 +375,16 @@ Addison-Wesley, 1975"
(fn [s]
(let [s1 (p s)]
(if (:ok s1)
- (let [s2 ((f (:value s1)) s1)
- s3 (assoc s2 :empty (and (:empty s1) (:empty s2)))]
- (if (:ok s3)
- s3
- (assoc s3 :error (merge-err s1 s3))))
- s1))))
-
+ (let [s2 ((f (:value s1)) s1)
+ s3 (assoc s2 :empty (and (:empty s1) (:empty s2)))]
+ (if (:ok s3)
+ s3
+ (assoc s3 :error (merge-err s1 s3))))
+ s1))))
-(defmacro bind
- "Expands into nested >>= forms and a function body. The pattern:
+#?(:clj
+ (defmacro bind
+ "Expands into nested >>= forms and a function body. The pattern:
(>>= p1 (fn [v1]
(>>= p2 (fn [v2]
@@ -395,11 +394,11 @@ Addison-Wesley, 1975"
can be more conveniently be written as:
(bind [v1 p1 v2 p2 ...] (return (f v1 v2 ...)))"
- [[& bindings] & body]
- (let [[sym p] (take 2 bindings)]
- (if (= 2 (count bindings))
- `(>>= ~p (fn [~sym] ~@body))
- `(>>= ~p (fn [~sym] (bind ~(drop 2 bindings) ~@body))))))
+ [[& bindings] & body]
+ (let [[sym p] (take 2 bindings)]
+ (if (= 2 (count bindings))
+ `(>>= ~p (fn [~sym] ~@body))
+ `(>>= ~p (fn [~sym] (bind ~(drop 2 bindings) ~@body)))))))
(defn >>
@@ -486,8 +485,8 @@ Addison-Wesley, 1975"
(fn [s]
(let [st (p s)]
(if (failed-empty? st)
- (reply x s)
- st))))
+ (reply x s)
+ st))))
(defn skip
@@ -536,7 +535,7 @@ Addison-Wesley, 1975"
of sep; returns the results of p in a vector."
[sep p] (many (<< p sep)))
-
+
(defn end-by1
"Parses p one or more times, separated and ended by applications
of sep; returns the results of p in a vector."
@@ -549,7 +548,7 @@ Addison-Wesley, 1975"
"Parses p one or more times separated, and optionally ended by sep;
collects the results in a vector."
[sep p]
- (>>= p (fn [x]
+ (>>= p (fn [x]
(<|> (>>= (>> sep (sep-end-by sep p)) (fn [y] (return (reduce conj [x] y))))
(return [x])))))
@@ -573,14 +572,14 @@ Addison-Wesley, 1975"
(apply <*> (repeat n p))
(return [])))
-
+
(defn look-ahead
"Applies p and returns the result; it consumes no input."
[p]
(fn [s]
(let [st (p s)]
(assoc s :value (:value st)))))
-
+
(defn predict
"Applies p; if it succeeds it consumes no input."
@@ -604,7 +603,7 @@ Addison-Wesley, 1975"
Returns the results in a vector."
[p end]
(letfn [(scan [] (<|> (>> end (return []))
- (>>= p (fn [x] (>>= (scan) (fn [y] (return (reduce conj [x] y))))))))]
+ (>>= p (fn [x] (>>= (scan) (fn [y] (return (reduce conj [x] y))))))))]
(scan)))
@@ -638,80 +637,92 @@ Addison-Wesley, 1975"
(def letter
"Parses a letter."
- ( (satisfy (fn [^Character c] (Character/isLetter c)))
+ ( (satisfy char/is-letter)
(di18n :letter)))
(def lower
"Parses a lower-case letter."
- ( (satisfy (fn [^Character c] (Character/isLowerCase c)))
+ ( (satisfy char/is-lower-case)
(di18n :lower)))
(def upper
"Parses an upper-case letter."
- ( (satisfy (fn [^Character c] (Character/isUpperCase c)))
+ ( (satisfy char/is-upper-case)
(di18n :upper)))
(def white-space
"Parses a whitespace character."
- ( (satisfy (fn [^Character c] (Character/isWhitespace c)))
+ ( (satisfy char/is-white-space)
(di18n :whitespace)))
(def space
"Parses the space character."
- ( (satisfy (fn [^Character c] (.equals c \space)))
+ ( (satisfy char/is-space)
(di18n :space)))
(def tab
"Parses the tab character."
- ( (satisfy (fn [^Character c] (.equals c \tab)))
+ ( (satisfy char/is-tab)
(di18n :tab)))
(def digit
"Parses a digit."
- ( (satisfy (fn [^Character c] (Character/isDigit c)))
+ ( (satisfy char/is-digit)
(di18n :digit)))
(def hex-digit
"Parses a hexadecimal digit."
(let [hex (set "0123456789abcdefABCDEF")]
- ( (satisfy (fn [^Character c] (hex c)))
- (di18n :hex-digit))))
+ ( (satisfy (fn [c] (hex c)))
+ (di18n :hex-digit))))
(def oct-digit
"Parses an octal digit."
(let [oct (set "01234567")]
- ( (satisfy (fn [^Character c] (oct c)))
- (di18n :oct-digit))))
+ ( (satisfy (fn [c] (oct c)))
+ (di18n :oct-digit))))
(def alpha-num
"Parses a letter or digit."
- ( (satisfy (fn [^Character c] (Character/isLetterOrDigit c)))
+ ( (satisfy char/is-letter-or-digit)
(di18n :alpha-num)))
-(defn sym*
- "Parses a single symbol x (a character)."
- [^Character x]
- ( (satisfy (fn [^Character c] (.equals c x)))
- (with-out-str (pr x))))
-
+#?(:clj (defn sym*
+ "Parses a single symbol x (a character)."
+ [^Character x]
+ ( (satisfy (fn [^Character c] (.equals c x)))
+ (with-out-str (pr x))))
+ :cljs (defn sym*
+ "Parses a single symbol x (a character)."
+ [x]
+ ( (satisfy (fn [c] (= c x)))
+ (with-out-str (pr x)))))
+
+#?(:clj (defn sym-
+ "Parses a single symbol x (a character); not case-sensitive."
+ [^Character x]
+ ( (>> (satisfy (fn [^Character c]
+ (= (Character/toLowerCase x) (Character/toLowerCase c))))
+ (return x))
+ (with-out-str (pr x))))
+ :cljs (defn sym-
+ "Parses a single symbol x (a character); not case-sensitive."
+ [x]
+ ( (>> (satisfy (fn [c]
+ (= (str/lower-case x) (str/lower-case c))))
+ (return x))
+ (with-out-str (pr x)))))
-(defn sym-
- "Parses a single symbol x (a character); not case-sensitive."
- [^Character x]
- ( (>> (satisfy (fn [^Character c]
- (= (Character/toLowerCase x) (Character/toLowerCase c))))
- (return x))
- (with-out-str (pr x))))
(defn token*
@@ -723,12 +734,12 @@ Addison-Wesley, 1975"
(if (:ok st)
(assoc st :value xs)
(let [in (:input s)]
- (if (seq in)
+ (if (seq in)
(unexpected (join (take (count xs) in)) s)
- (assoc s :value nil :ok false :empty true :error (:error st)))))))
+ (assoc s :value nil :ok false :empty true :error (:error st)))))))
(str xs)))
- ([xs & more]
- (apply <|> (map token* (cons xs more)))))
+ ([xs & more]
+ (apply <|> (map token* (cons xs more)))))
(defn token-
@@ -741,9 +752,9 @@ Addison-Wesley, 1975"
(if (:ok st)
(assoc st :value xs)
(let [in (:input s)]
- (if (seq in)
+ (if (seq in)
(unexpected (join (take (count xs) in)) s)
- (assoc s :value nil :ok false :empty true :error (:error st)))))))
+ (assoc s :value nil :ok false :empty true :error (:error st)))))))
(str xs)))
([xs & more]
(apply <|> (map token- (cons xs more)))))
@@ -769,14 +780,14 @@ Addison-Wesley, 1975"
(apply <|> (map #(word- letter %) (cons cs more)))))
+
(defn one-of*
"Succeeds if the next character is in the supplied string."
- [^String cs] (satisfy #(>= (.indexOf cs (int %)) 0)))
-
+ [cs] (satisfy #(str/index-of cs %)))
(defn none-of*
"Succeeds if the next character is not in the supplied string."
- [^String cs] (satisfy #(neg? (.indexOf cs (int %)))))
+ [cs] (satisfy #(nil? (str/index-of cs %))))
(def new-line*
@@ -834,7 +845,8 @@ Addison-Wesley, 1975"
"Parses a decimal integer delimited by any character that
is not a decimal digit."
( (>>= (<+> (many1 digit))
- (fn [x] (return (read-string (rmvz x)))))
+ (fn [x] (return #?(:clj (read-string (rmvz x))
+ :cljs (js/eval (rmvz x))))))
(di18n :dec-lit)))
@@ -842,7 +854,8 @@ Addison-Wesley, 1975"
"Parses an octal integer delimited by any character that
is not an octal digit."
( (>>= (<+> (many1 oct-digit))
- (fn [x] (return (read-string (str "0" x)))))
+ (fn [x] (return #?(:clj (read-string (str "0" x))
+ :cljs (js/eval (str "0" x))))))
(di18n :oct-lit)))
@@ -850,7 +863,8 @@ Addison-Wesley, 1975"
"Parses a hex integer delimited by any character that
is not a hex digit."
( (>>= (<+> (many1 hex-digit))
- (fn [x] (return (read-string (str "0x" x)))))
+ (fn [x] (return #?(:clj (read-string (str "0x" x))
+ :cljs (js/eval (str "0x" x))))))
(di18n :hex-lit)))
@@ -860,8 +874,9 @@ Addison-Wesley, 1975"
digit. It cannot start with a period; the first period
found must be followed by at least one digit."
( (>>= (<+> (many1 digit)
- (option ".0" (<*> (sym* \.) (many1 digit))))
- (fn [x] (return (read-string x))))
+ (option ".0" (<*> (sym* \.) (many1 digit))))
+ (fn [x] (return #?(:clj (read-string x)
+ :cljs (js/eval x)))))
(di18n :float-lit)))
@@ -939,10 +954,10 @@ Addison-Wesley, 1975"
[s]
(let [err (:error s)
pos (:pos err)
- src (let [l (:src pos)] (if (empty? l) "" (str l " ")))
- ln (:line pos)
- col (:col pos)]
- (printf (i18n :err-pos) src ln col)
+ src (let [l (:src pos)] (if (empty? l) "" (str l " ")))
+ ln (:line pos)
+ col (:col pos)]
+ (print (fmt :err-pos src ln col))
(println (get-msg-str err))))
@@ -953,12 +968,12 @@ Addison-Wesley, 1975"
([p cs] (run p cs nil nil))
([p cs src] (run p cs src nil))
([p cs src us]
- (let [s (parse p cs src us)]
- (if (:ok s)
- (pprint (:value s))
- (print-error s))
- (if-let [us (:user s)]
- (pprint us)))))
+ (let [s (parse p cs src us)]
+ (if (:ok s)
+ (pprint (:value s))
+ (print-error s))
+ (if-let [us (:user s)]
+ (pprint us)))))
(defn run*
@@ -969,28 +984,28 @@ Addison-Wesley, 1975"
([p cs src us] (pprint (parse p cs src us))))
-(defn parse-file
- "Parses a file; takes an optional encoding and user state,
- which default to utf-8 and nil. Returns a PState record."
- ([p f] (parse-file p f "UTF-8" nil))
- ([p f en] (parse-file p f en nil))
- ([p f en us] (parse p (slurp f :encoding en) f us)))
+#?(:clj (defn parse-file
+ "Parses a file; takes an optional encoding and user state,
+ which default to utf-8 and nil. Returns a PState record."
+ ([p f] (parse-file p f "UTF-8" nil))
+ ([p f en] (parse-file p f en nil))
+ ([p f en us] (parse p (slurp f :encoding en) f us))))
-(defn runf
- "For testing, e.g. at the REPL, with input from files.
- Prints the results."
- ([p f] (runf p f "UTF-8" nil))
- ([p f en] (runf p f en nil))
- ([p f en us] (run p (slurp f :encoding en) f us)))
+#?(:clj (defn runf
+ "For testing, e.g. at the REPL, with input from files.
+ Prints the results."
+ ([p f] (runf p f "UTF-8" nil))
+ ([p f en] (runf p f en nil))
+ ([p f en us] (run p (slurp f :encoding en) f us))))
-(defn runf*
- "For testing, e.g. at the REPL, with input from files.
- Pretty-prints the results."
- ([p f] (runf* p f "UTF-8" nil))
- ([p f en] (runf* p f en nil))
- ([p f en us] (pprint (parse-file p f en us))))
+#?(:clj (defn runf*
+ "For testing, e.g. at the REPL, with input from files.
+ Pretty-prints the results."
+ ([p f] (runf* p f "UTF-8" nil))
+ ([p f en] (runf* p f en nil))
+ ([p f en us] (pprint (parse-file p f en us)))))
;; +-------------------------------------------------------------+
@@ -1000,10 +1015,10 @@ Addison-Wesley, 1975"
;; +-------------------------------------------------------------+
-(defn- char-pos-x [x _] x)
-(defn- str-pos-x [x _] x)
+(defn- char-pos-x [x _] x)
+(defn- str-pos-x [x _] x)
(defn- merge-err-x [_ _] nil)
-(defn- set-ex-x [_ x] x)
+(defn- set-ex-x [_ x] x)
(defn parse-data
@@ -1013,22 +1028,23 @@ Addison-Wesley, 1975"
([p cs] (parse-data p cs nil nil))
([p cs src] (parse-data p cs src nil))
([p cs src us]
- (binding [char-pos char-pos-x
- str-pos str-pos-x
- merge-err merge-err-x
- set-ex set-ex-x]
- (parse p cs src us))))
-
-
-(defn parse-data-file
- "Works like (parse-file) but with error diagnostics disabled for
- better performance. It's intended for data files that can be
- assumed to be correct or its diagnosis postponed."
- ([p f] (parse-data-file p f "UTF-8" nil))
- ([p f en] (parse-data-file p f en nil))
- ([p f en us]
- (binding [char-pos char-pos-x
- str-pos str-pos-x
- merge-err merge-err-x
- set-ex set-ex-x]
- (parse-file p f en us))))
+ (binding [char-pos char-pos-x
+ str-pos str-pos-x
+ merge-err merge-err-x
+ set-ex set-ex-x]
+ (parse p cs src us))))
+
+
+#?(:clj
+ (defn parse-data-file
+ "Works like (parse-file) but with error diagnostics disabled for
+ better performance. It's intended for data files that can be
+ assumed to be correct or its diagnosis postponed."
+ ([p f] (parse-data-file p f "UTF-8" nil))
+ ([p f en] (parse-data-file p f en nil))
+ ([p f en us]
+ (binding [char-pos char-pos-x
+ str-pos str-pos-x
+ merge-err merge-err-x
+ set-ex set-ex-x]
+ (parse-file p f en us)))))
diff --git a/src/main/clojure/blancas/kern/expr.clj b/src/main/clojure/blancas/kern/expr.cljc
similarity index 81%
rename from src/main/clojure/blancas/kern/expr.clj
rename to src/main/clojure/blancas/kern/expr.cljc
index 960eced..09e5961 100644
--- a/src/main/clojure/blancas/kern/expr.clj
+++ b/src/main/clojure/blancas/kern/expr.cljc
@@ -9,8 +9,10 @@
(ns ^{:doc "Support for the evaluation of expressions."
:author "Armando Blancas"}
blancas.kern.expr
- (:use [blancas.kern core i18n]
- [blancas.kern.lexer.c-style]))
+ (:require [blancas.kern.core :as k :refer [<|> return >>]]
+ [blancas.kern.i18n :as i18n]
+ [blancas.kern.lexer.c-style :as c-style])
+ #?(:cljs (:require-macros [blancas.kern.core :as k])))
;; +-------------------------------------------------------------+
@@ -23,9 +25,9 @@
another instance of p, then applies the operator on both values.
The operator associates to the left."
[p op]
- (letfn [(rest [a] (<|> (bind [f op b p] (rest (f a b)))
+ (letfn [(rest [a] (<|> (k/bind [f op b p] (rest (f a b)))
(return a)))]
- (bind [a p] (rest a))))
+ (k/bind [a p] (rest a))))
(defn chainl
@@ -39,8 +41,8 @@
calls itself to compute the rest of the expression, then it applies
the operator on both values. The operator associates to the right."
[p op]
- (bind [a p]
- (<|> (bind [f op b (chainr1 p op)] (return (f a b)))
+ (k/bind [a p]
+ (<|> (k/bind [f op b (chainr1 p op)] (return (f a b)))
(return a))))
@@ -55,10 +57,10 @@
another p, then makes an AST node with the operator on both values.
The operator associates to the left."
[tok p op]
- (letfn [(rest [a] (<|> (bind [f op b p]
+ (letfn [(rest [a] (<|> (k/bind [f op b p]
(rest {:token tok :op f :left a :right b}))
(return a)))]
- (bind [a p] (rest a))))
+ (k/bind [a p] (rest a))))
(defn chainl*
@@ -74,8 +76,8 @@
an AST node with the operator on both values. The operator associates
to the right."
[tok p op]
- (bind [a p]
- (<|> (bind [f op b (chainr1* tok p op)]
+ (k/bind [a p]
+ (<|> (k/bind [f op b (chainr1* tok p op)]
(return {:token tok :op f :left a :right b}))
(return a))))
@@ -91,8 +93,8 @@
"Parses zero or more operators op before an operand p. It applies
the parsed functions to the operand in reverse order of parsing."
[p op]
- (<|> (bind [f op a (prefix1 p op)] (return (f a)))
- (bind [a p] (return a))))
+ (<|> (k/bind [f op a (prefix1 p op)] (return (f a)))
+ (k/bind [a p] (return a))))
(defn prefix
@@ -106,8 +108,8 @@
AST node for each parsed function, where the operand is a node
for a value or a further application of a prefix operator."
[tok p op]
- (<|> (bind [f op a (prefix1* tok p op)] (return {:token tok :op f :right a}))
- (bind [a p] (return a))))
+ (<|> (k/bind [f op a (prefix1* tok p op)] (return {:token tok :op f :right a}))
+ (k/bind [a p] (return a))))
(defn prefix*
@@ -120,9 +122,9 @@
"Parses an operand p followed by zero or more operators. It applies the
parsed functions to the operand or the result of a previous application."
[p op]
- (letfn [(rest [a] (<|> (bind [f op] (rest (f a)))
+ (letfn [(rest [a] (<|> (k/bind [f op] (rest (f a)))
(return a)))]
- (bind [a p] (rest a))))
+ (k/bind [a p] (rest a))))
(defn postfix
@@ -136,9 +138,9 @@
an AST node for each parsed function, where the operand is a node
for a value or a previous application of a postfix operator."
[tok p op]
- (letfn [(rest [a] (<|> (bind [f op] (rest {:token tok :op f :left a}))
+ (letfn [(rest [a] (<|> (k/bind [f op] (rest {:token tok :op f :left a}))
(return a)))]
- (bind [a p] (rest a))))
+ (k/bind [a p] (rest a))))
(defn postfix*
@@ -154,38 +156,38 @@
(def pow-op
"Parses the POW operator."
- (>> (sym \^) (return #(Math/pow %1 %2))))
+ (>> (c-style/sym \^) (return #(Math/pow %1 %2))))
(def uni-op
"Unary prefix operator: logical not or numeric minus."
- (bind [op (one-of "!-")]
+ (k/bind [op (c-style/one-of "!-")]
(return ({\! not \- -} op))))
(def mul-op
"Multiplicative operator: multiplication, division, or modulo."
- (bind [op (one-of "*/%")]
+ (k/bind [op (c-style/one-of "*/%")]
(return ({\* * \/ quot \% mod} op))))
(def add-op
"Additive operator: addition or subtraction."
- (bind [op (one-of "+-")]
+ (k/bind [op (c-style/one-of "+-")]
(return ({\+ + \- -} op))))
(def rel-op
"Parses one of the relational operators."
- (bind [op (token "==" "!=" ">=" "<=" ">" "<")]
+ (k/bind [op (c-style/token "==" "!=" ">=" "<=" ">" "<")]
(return ({"==" = "!=" not= ">=" >= "<=" <= ">" > "<" <} op))))
(def and-op
"Parses the logical AND operator."
- (>> (token "&&") (return #(and %1 %2))))
+ (>> (c-style/token "&&") (return #(and %1 %2))))
(def or-op
"Parses the logical OR operator."
- (>> (token "||") (return #(or %1 %2))))
+ (>> (c-style/token "||") (return #(or %1 %2))))
diff --git a/src/main/clojure/blancas/kern/i18n.clj b/src/main/clojure/blancas/kern/i18n.clj
deleted file mode 100644
index d256b23..0000000
--- a/src/main/clojure/blancas/kern/i18n.clj
+++ /dev/null
@@ -1,80 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns ^{:doc "Support for a simple i18n scheme."
- :author "Armando Blancas"}
- blancas.kern.i18n)
-
-
-(def ^:private default
- { :unexpected "unexpected %s"
- :expecting "expecting %s"
- :comma ", "
- :or " or %s"
- :err-pos "%sline %d column %d\n"
- :eof "end of input"
- :letter "letter"
- :lower "lowercase letter"
- :upper "uppercase letter"
- :whitespace "whitespace"
- :space "space"
- :new-line "new line"
- :tab "tab"
- :digit "digit"
- :hex-digit "hexadecimal digit"
- :oct-digit "octal digit"
- :alpha-num "letter or digit"
- :end-comment "end of comment"
- :char-lit "character literal"
- :end-char "end of character literal"
- :esc-code-b "escaped code: b, t, n, f, r, ', \\"
- :esc-code-c "escaped code: b, t, n, f, r, ', \\, ?, a, v, 0, ooo, uhhhh, xhh"
- :esc-code-j "escaped code: b, t, n, f, r, ', \\, ooo, hhhh"
- :esc-code-h "escaped code: b, t, n, f, r, ', \\, ?, a, v, 0, nnn, onnn, xnnnn"
- :string-lit "string literal"
- :end-string "end of string literal"
- :end-of "end of "
- :dec-lit "decimal literal"
- :oct-lit "octal literal"
- :hex-lit "hex literal"
- :float-lit "floating-point literal"
- :reserved "%s is a reserved name"
- })
-
-
-(def ^:private text (atom default))
-
-
-(defn i18n-merge
- "Merges m into the text map for customization."
- [m] (swap! text merge m))
-
-
-(defn i18n
- "Gets or sets the value for the supplied key."
- ([k] (k (deref text)))
- ([k v] (swap! text assoc k v)))
-
-
-(defn fmt
- "Formats a string with a key and more arguments."
- [k & more]
- (apply format (i18n k) more))
-
-
-(defn di18n
- "Returns a Delay instance with the value for the supplied key.
- Useful in (def)'ed expressions that evaluate too soon."
- [k] (delay (k (deref text))))
-
-
-(defn dfmt
- "Returns a Delay instance with a string formatted with a key and more
- arguments. Useful in (def)'ed expressions that evaluate too soon."
- [k & more]
- (delay (apply format (i18n k) more)))
diff --git a/src/main/clojure/blancas/kern/i18n.cljc b/src/main/clojure/blancas/kern/i18n.cljc
new file mode 100644
index 0000000..054fd1b
--- /dev/null
+++ b/src/main/clojure/blancas/kern/i18n.cljc
@@ -0,0 +1,83 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns ^{:doc "Support for a simple i18n scheme."
+ :author "Armando Blancas"}
+ blancas.kern.i18n
+ #?(:cljs (:require
+ [goog.string :refer [format]]
+ [goog.string.format])))
+
+
+(def ^:private default
+ { :unexpected "unexpected %s"
+ :expecting "expecting %s"
+ :comma ", "
+ :or " or %s"
+ :err-pos "%sline %d column %d\n"
+ :eof "end of input"
+ :letter "letter"
+ :lower "lowercase letter"
+ :upper "uppercase letter"
+ :whitespace "whitespace"
+ :space "space"
+ :new-line "new line"
+ :tab "tab"
+ :digit "digit"
+ :hex-digit "hexadecimal digit"
+ :oct-digit "octal digit"
+ :alpha-num "letter or digit"
+ :end-comment "end of comment"
+ :char-lit "character literal"
+ :end-char "end of character literal"
+ :esc-code-b "escaped code: b, t, n, f, r, ', \\"
+ :esc-code-c "escaped code: b, t, n, f, r, ', \\, ?, a, v, 0, ooo, uhhhh, xhh"
+ :esc-code-j "escaped code: b, t, n, f, r, ', \\, ooo, hhhh"
+ :esc-code-h "escaped code: b, t, n, f, r, ', \\, ?, a, v, 0, nnn, onnn, xnnnn"
+ :string-lit "string literal"
+ :end-string "end of string literal"
+ :end-of "end of "
+ :dec-lit "decimal literal"
+ :oct-lit "octal literal"
+ :hex-lit "hex literal"
+ :float-lit "floating-point literal"
+ :reserved "%s is a reserved name"
+ })
+
+
+(def ^:private text (atom default))
+
+
+(defn i18n-merge
+ "Merges m into the text map for customization."
+ [m] (swap! text merge m))
+
+
+(defn i18n
+ "Gets or sets the value for the supplied key."
+ ([k] (k (deref text)))
+ ([k v] (swap! text assoc k v)))
+
+
+(defn fmt
+ "Formats a string with a key and more arguments."
+ [k & more]
+ (apply format (i18n k) more))
+
+
+(defn di18n
+ "Returns a Delay instance with the value for the supplied key.
+ Useful in (def)'ed expressions that evaluate too soon."
+ [k] (delay (k (deref text))))
+
+
+(defn dfmt
+ "Returns a Delay instance with a string formatted with a key and more
+ arguments. Useful in (def)'ed expressions that evaluate too soon."
+ [k & more]
+ (delay (apply format (i18n k) more)))
diff --git a/src/main/clojure/blancas/kern/lexer.clj b/src/main/clojure/blancas/kern/lexer.clj
deleted file mode 100644
index 8292259..0000000
--- a/src/main/clojure/blancas/kern/lexer.clj
+++ /dev/null
@@ -1,734 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns ^{:doc "The Kern Lexer library."
- :author "Armando Blancas"}
- blancas.kern.lexer
- (:use [blancas.kern core i18n]
- [clojure.string :only (lower-case)]))
-
-
-;; +-------------------------------------------------------------+
-;; | Language definitions. |
-;; +-------------------------------------------------------------+
-
-
-;; A language def record customizes the parsers returned by make-parsers.
-(defrecord LanguageDef
- [type ;; Identifies the type of settings.
- comment-start ;; A string that marks the start of a block comment.
- comment-end ;; A string that marks the end of a block comment.
- comment-line ;; A string that marks the start of a line comment.
- nested-comments ;; Whether the lexer accepts nested comments; a boolean.
- identifier-start ;; A parser for the start of an identifier.
- identifier-letter ;; A parser for the subsequent characters of an identifier.
- reserved-names ;; A list of names that cannot be identifiers.
- case-sensitive ;; Whether tokens are case-sensitive; a boolean.
- line-continuation ;; A parser for the token that precedes the new line.
- trim-newline ;; Treats newline character(s) as whitespace.
- leading-sign]) ;; Whether numbers accept an optional leading sign.
-
-
-(def basic-def
- "The most basic record; for use to build new styles."
- (map->LanguageDef
- {:type :basic
- :comment-start ""
- :comment-end ""
- :comment-line ""
- :nested-comments false
- :identifier-start (<|> letter (sym* \_))
- :identifier-letter (<|> alpha-num (sym* \_))
- :reserved-names []
- :case-sensitive true
- :line-continuation (sym* \\)
- :trim-newline true
- :leading-sign true}))
-
-
-(def haskell-style
- "Lexical settings for Haskell-style languages."
- (assoc basic-def
- :type :Haskell
- :comment-start "{-"
- :comment-end "-}"
- :comment-line "--"
- :nested-comments true))
-
-
-(def java-style
- "Lexical settings for Java-style languages."
- (assoc basic-def
- :type :Java
- :comment-start "/*"
- :comment-end "*/"
- :comment-line "//"))
-
-
-(def c-style
- "Lexical settings for C-style languages."
- (assoc java-style
- :type :C))
-
-
-(def shell-style
- "Lexical settings for shell-style languages."
- (assoc basic-def
- :type :Shell
- :comment-line "#"
- :identifier-letter (<|> alpha-num (one-of* "_-."))
- :trim-newline false))
-
-
-;; +-------------------------------------------------------------+
-;; | Parser definitions. |
-;; +-------------------------------------------------------------+
-
-
-(defrecord TokenParsers
- [trim
- lexeme
- sym
- new-line
- one-of
- none-of
- token
- word
- identifier
- field
- char-lit
- string-lit
- dec-lit
- oct-lit
- hex-lit
- float-lit
- bool-lit
- nil-lit
- parens
- braces
- angles
- brackets
- semi
- comma
- colon
- dot
- semi-sep
- semi-sep1
- comma-sep
- comma-sep1])
-
-
-(defn* trim
- "Skips over any whitespace, including comments (if defined), at
- the start of the input. Whether newline characters are removed
- as whitespace is configured by :trim-newline. When that setting
- is true, the setting :line-continuation is activated."
- [] nil)
-
-(defn* lexeme
- "Applies parser p, then calls (trim)."
- [p] nil)
-
-(defn* sym
- "Parses a single character c. Compares according to
- :case-sensitive. Calls (trim) afterwards."
- [c] nil)
-
-(defn* new-line
- "Parses a new line, UNIX or Windows style; then calls (trim)."
- [] nil)
-
-(defn* one-of
- "Succeeds if the next character is in the supplied string.
- Calls (trim) afterwards."
- [cs] nil)
-
-(defn* none-of
- "Succeeds if the next character is not in the supplied string.
- Calls (trim) afterwards."
- [] nil)
-
-(defn* token
- "Parses a specific string, not necessarily delimited. If more
- than one are given it will try each choice in turn. Compares
- according to :case-sensitive. Calls (trim) afterwards."
- ([cs] nil)
- ([cs & more] nil))
-
-(defn* word
- "Parses a specific string; must be delimited by any character not
- parsed by :identifier-letter. If more than one are given it will
- try each choice in turn. Compares according to :case-sensitive.
- Calls (trim) afterwards."
- ([cs] nil)
- ([cs & more] nil))
-
-(defn* identifier
- "Parses an unquoted string suitable for an identifier or a name.
- The start of the input is defined by :identifier-start, and
- subsequent symbols by :identtifier-letter. It will check that
- the parsed value not be in the list of :reserved-names, if any,
- comparing according to :case-sensitive. Calls (trim) afterwards."
- [] nil)
-
-(defn* field
- "Parses an unquoted text field terminated by any character
- in cs. Calls (trim) afterwards."
- [cs] nil)
-
-(defn* char-lit
- "Parses a character literal according to the :type setting. The
- common syntax is a symbol in single quotes with the usual
- escape codes. Calls (trim) afterwards.
-
- The following styles add escaped characters:
-
- :basic \\b \\t \\n \\f \\r \\' \\\" \\/
- :C :basic + \\0ooo \\0xnn \\unnnnnnnn
- :Haskell :basic + \\nnnn \\onnnn \\xnnnn
- :Java :basic + \\0ooo \\unnnn
- :Shell :basic + \\0ooo \\0xnn \\unnnnnnnn"
- [] nil)
-
-(defn* string-lit
- "Parses a string literal according to the :type setting. The
- common syntax is any number of symbols in double quotes
- with the usual escape codes. Calls (trim) afterward.
-
- The following styles add escaped characters:
-
- :basic \\b \\t \\n \\f \\r \\' \\\" \\/
- :C :basic + \\0ooo \\0xnn \\unnnnnnnn
- :Haskell :basic + \\nnnn \\onnnn \\xnnnn
- :Java :basic + \\0ooo \\unnnn
- :Shell :basic + \\0ooo \\0xnn \\unnnnnnnn"
- [] nil)
-
-(defn* dec-lit
- "Parses a decimal number as Long or BigInt depending on the
- magnitude or if it ends with N. Calls (trim) afterward."
- [] nil)
-
-(defn* oct-lit
- "Parses an octal number as Long or BigInt depending on the
- magnitude or if it ends with N. Calls (trim) afterward."
- [] nil)
-
-(defn* hex-lit
- "Parses a hexadecimal number as Long or BigInt depending on the
- magnitude or if it ends with N. Calls (trim) afterward."
- [] nil)
-
-(defn* float-lit
- "Parses a floating-point number as Double or BigDecimal depending
- on the magnitude or if it ends with M. It cannot start with a
- period. The first period found must be followed by at least one
- digit. Calls (trim) afterward."
- [] nil)
-
-(defn* bool-lit
- "Parses a boolean value, true or false, comparing according to
- :case-sensitive. Calls (trim) afterward."
- [] nil)
-
-(defn* nil-lit
- "Parses a null value, nil or null, comparing according to
- :case-sensitive. Calls (trim) afterward."
- [] nil)
-
-(defn* parens
- "Applies parser p skiping over surrounding parenthesis.
- Calls (trim) after the opening paren, after p, and after
- the closing paren."
- [p] nil)
-
-(defn* braces
- "Applies parser p skiping over surrounding braces.
- Calls (trim) after the opening brace, after p, and after
- the closing brace."
- [p] nil)
-
-(defn* angles
- "Applies parser p skiping over surrounding angle brackets.
- Calls (trim) after the opening bracket, after p, and after
- the closing bracket."
- [p] nil)
-
-(defn* brackets
- "Applies parser p skiping over surrounding brackets.
- Calls (trim) after the opening bracket, after p, and after
- the closing bracket."
- [p] nil)
-
-(defn* semi
- "Parses a single semicolon; then calls (trim)."
- [] nil)
-
-(defn* comma
- "Parses a single comma; then calls (trim)."
- [] nil)
-
-(defn* colon
- "Parses a single colon; then calls (trim)."
- [] nil)
-
-(defn* dot
- "Parses a single dot; then calls (trim)."
- [] nil)
-
-(defn* semi-sep
- "Applies parser p zero or more times, skiping over separating
- semicolons. Calls (trim) after each p and semicolon."
- [] nil)
-
-(defn* semi-sep1
- "Applies parser p one or more times, skiping over separating
- semicolons. Calls (trim) after each p and semicolon."
- [] nil)
-
-(defn* comma-sep
- "Applies parser p zero or more times, skiping over separating
- commas. Calls (trim) after each p and comma."
- [] nil)
-
-(defn* comma-sep1
- "Applies parser p one or more times, skiping over separating
- commas. Calls (trim) after each p and comma."
- [] nil)
-
-
-(defmacro with-parsers
- "Binds the parser vars in the kern.lexer namespace to the values in rec."
- [rec & body]
- (list 'binding
- ['blancas.kern.lexer/trim (list :trim rec)
- 'blancas.kern.lexer/lexeme (list :lexeme rec)
- 'blancas.kern.lexer/sym (list :sym rec)
- 'blancas.kern.lexer/new-line (list :new-line rec)
- 'blancas.kern.lexer/one-of (list :one-of rec)
- 'blancas.kern.lexer/none-of (list :none-of rec)
- 'blancas.kern.lexer/token (list :token rec)
- 'blancas.kern.lexer/word (list :word rec)
- 'blancas.kern.lexer/identifier (list :identifier rec)
- 'blancas.kern.lexer/field (list :field rec)
- 'blancas.kern.lexer/char-lit (list :char-lit rec)
- 'blancas.kern.lexer/string-lit (list :string-lit rec)
- 'blancas.kern.lexer/dec-lit (list :dec-lit rec)
- 'blancas.kern.lexer/oct-lit (list :oct-lit rec)
- 'blancas.kern.lexer/hex-lit (list :hex-lit rec)
- 'blancas.kern.lexer/float-lit (list :float-lit rec)
- 'blancas.kern.lexer/bool-lit (list :bool-lit rec)
- 'blancas.kern.lexer/nil-lit (list :nil-lit rec)
- 'blancas.kern.lexer/parens (list :parens rec)
- 'blancas.kern.lexer/braces (list :braces rec)
- 'blancas.kern.lexer/angles (list :angles rec)
- 'blancas.kern.lexer/brackets (list :brackets rec)
- 'blancas.kern.lexer/semi (list :semi rec)
- 'blancas.kern.lexer/comma (list :comma rec)
- 'blancas.kern.lexer/colon (list :colon rec)
- 'blancas.kern.lexer/dot (list :dot rec)
- 'blancas.kern.lexer/semi-sep (list :semi-sep rec)
- 'blancas.kern.lexer/semi-sep1 (list :semi-sep1 rec)
- 'blancas.kern.lexer/comma-sep (list :comma-sep rec)
- 'blancas.kern.lexer/comma-sep1 (list :comma-sep1 rec)]
- (cons 'do body)))
-
-
-;; +-------------------------------------------------------------+
-;; | Private functions for whitespace. |
-;; +-------------------------------------------------------------+
-
-
-(defn- line-comment
- "Parses a line comment."
- [rec]
- (let [start (:comment-line rec)]
- (>>= (token* start)
- (fn [_] (>>= (many-till any-char (<|> new-line* eof))
- (fn [_] (return nil)))))))
-
-
-(defn- block-nested
- "Parses the contents and end of a nested block comment."
- [rec]
- (let [start (:comment-start rec)
- end (:comment-end rec)]
- (expect (many-till (<|> (>>= (<:> (token* start)) (fn [_] (block-nested rec)))
- any-char)
- (token* end))
- (i18n :end-comment))))
-
-
-(defn- block-rest
- "Parses the contents and end of a block comment."
- [rec]
- (let [end (:comment-end rec)]
- (expect (many-till any-char (token* end)) (i18n :end-comment))))
-
-
-(defn- block-comment
- "Parses a block comment."
- [rec]
- (let [start (:comment-start rec)
- nest? (:nested-comments rec)]
- (skip (<:> (token* start))
- (if nest? (block-nested rec) (block-rest rec)))))
-
-
-;; +-------------------------------------------------------------+
-;; | Private functions for character and string literals. |
-;; +-------------------------------------------------------------+
-
-
-(def space-ascii 32)
-
-
-(def- esc-char
- "Parses an escape code for a basic char."
- (let [codes (zipmap "btnfr'\"\\/" "\b\t\n\f\r'\"\\/")]
- (>>= ( (one-of* "btnfr'\"\\/") (i18n :esc-code))
- (fn [x] (return (get codes x))))))
-
-
-(defn- basic-char
- "Parses an unquoted character literal. Character c must be escaped."
- [c]
- ( (<|> (satisfy #(and (not= % c) (not= % \\) (>= (int %) space-ascii)))
- (>> (sym* \\) esc-char))
- (i18n :char-lit)))
-
-
-(def- esc-oct
- "Parses an octal escape code; the result is the encoded char."
- (>>= (<+> (many1 oct-digit))
- (fn [x]
- (let [n (Integer/parseInt x 8)]
- (if (<= n 0377)
- (return (char n))
- (fail (i18n :bad-octal)))))))
-
-
-(def- esc-uni
- "Parses a unicode escape code; the result is the encoded char."
- (>>= (<+> (>> (sym* \u) (times 4 hex-digit)))
- (fn [x] (return (aget (Character/toChars (Integer/parseInt x 16)) 0)))))
-
-
-(defn- java-char
- "Parses an unquoted Java character literal. Character c must be escaped."
- [c]
- ( (<|> (satisfy #(and (not= % c) (not= % \\) (>= (int %) space-ascii)))
- (>> (sym* \\)
- ( (<|> esc-char esc-oct esc-uni)
- (i18n :esc-code-j))))
- (i18n :char-lit)))
-
-
-(def- c-esc-char
- "Parses an escape code for a C char."
- (let [codes (assoc (zipmap "btnfr'\"\\?/" "\b\t\n\f\r'\"\\?/")
- \a (char 7) \v (char 11) \0 (char 0))]
- (>>= (one-of* "btnfr'\"\\?/av0") (fn [x] (return (get codes x))))))
-
-
-(def- c-esc-uni
- "Parses a long unicode escape code; the result is the encoded char."
- (>>= (<+> (>> (sym* \U) (times 8 hex-digit)))
- (fn [x] (return (aget (Character/toChars (Integer/parseInt x 16)) 0)))))
-
-
-(def- c-esc-hex
- "Parses a hex escape code; the result is the encoded char."
- (>>= (<+> (>> (sym- \x) (times 2 hex-digit)))
- (fn [x] (return (aget (Character/toChars (Integer/parseInt x 16)) 0)))))
-
-
-(defn- c-char
- "Parses an unquoted C character literal. Character c must be escaped."
- [c]
- ( (<|> (satisfy #(and (not= % c) (not= % \\) (>= (int %) space-ascii)))
- (>> (sym* \\)
- ( (<|> c-esc-hex c-esc-char esc-oct esc-uni c-esc-uni)
- (i18n :esc-code-c))))
- (i18n :char-lit)))
-
-
-(def- h-esc-oct
- "Parses a Haskell octal escape code; the result is the encoded char."
- (>>= (<+> (>> (sym* \o) (many1 oct-digit)))
- (fn [x]
- (let [n (Integer/parseInt x 8)]
- (if (<= n 04177777)
- (return (char n))
- (fail (i18n :bad-oct-h)))))))
-
-
-(def- h-esc-dec
- "Parses a Haskell decimal escape code; the result is the encoded char."
- (>>= (<+> (many1 digit))
- (fn [x]
- (let [n (Integer/parseInt x)]
- (if (<= n 1114111)
- (return (char n))
- (fail (i18n :bad-dec-h)))))))
-
-
-(def- h-esc-hex
- "Parses a Haskell hex escape code; the result is the encoded char."
- (>>= (<+> (>> (sym* \x) (many1 hex-digit)))
- (fn [x]
- (let [n (Integer/parseInt x 16)]
- (if (<= n 0x10ffff)
- (return (char n))
- (fail (i18n :bad-hex-h)))))))
-
-
-(defn- haskell-char
- "Parses Haskell character literals."
- [c]
- ( (<|> (satisfy #(and (not= % c) (not= % \\) (>= (int %) space-ascii)))
- (>> (sym* \\)
- ( (<|> h-esc-hex h-esc-oct c-esc-char h-esc-dec)
- (i18n :esc-code-h))))
- (i18n :char-lit)))
-
-
-(defn- char-parser
- "Parses character literals delimited by single quotes."
- [lex f]
- ( (lex (between (sym* \') ( (sym* \') (i18n :end-char)) (f \')))
- (i18n :char-lit)))
-
-
-(defn- str-parser
- "Parses string literals delimited by double quotes."
- [lex f]
- ( (lex (between (sym* \")
- ( (sym* \") (i18n :end-string))
- (<+> (many (f \")))))
- (i18n :string-lit)))
-
-
-;; +-------------------------------------------------------------+
-;; | Private functions for numeric literals. |
-;; +-------------------------------------------------------------+
-
-
-(def- sign (optional (one-of* "+-")))
-
-(def- int-suffix (<|> (<< (sym* \N) (not-followed-by letter))
- (not-followed-by (<|> letter (sym* \.)))))
-
-(def- float-suffix (<< (optional (sym* \M)) (not-followed-by letter)))
-
-
-;; +-------------------------------------------------------------+
-;; | Parser generator. |
-;; +-------------------------------------------------------------+
-
-
-(defn make-parsers
- "Returns a function map that corresponds to the customization
- values of the input record, whose fields are as follows:
-
- :type Identifies the type of settings.
- :comment-start A string that marks the start of a block comment.
- :comment-end A string that marks the end of a block comment.
- :comment-line A string that marks the start of a line comment.
- :nested-comments Whether the lexer accepts nested comments; a boolean.
- :identifier-start A parser for the start of an identifier.
- :identifier-letter A parser for the subsequent characters of an identifier.
- :reserved-names A list of names that cannot be identifiers.
- :case-sensitive Whether tokens are case-sensitive; a boolean.
- :line-continuation A parser for the token that precedes the new line.
- :trim-newline Treats newline character(s) as whitespace.
- :leading-sign Whether numbers accept an optional leading sign."
- [rec]
- (let [trim
- (let [line? (seq (:comment-line rec))
- multi? (seq (:comment-start rec))
- both? (and line? multi?)
- ws (if (:trim-newline rec)
- white-space
- (<|> (one-of* "\t\f\r ")
- (skip (:line-continuation rec) new-line*)))
- many-ws (skip-many1 ws)]
- (cond both? (skip-many (<|> many-ws (line-comment rec) (block-comment rec)))
- line? (skip-many (<|> many-ws (line-comment rec)))
- multi? (skip-many (<|> many-ws (block-comment rec)))
- :else (skip-many ws)))
-
- lexeme
- (fn [p] (<< p trim))
-
- sym
- (if (:case-sensitive rec)
- (fn [x] (lexeme (sym* x)))
- (fn [x] (lexeme (sym- x))))
-
- new-line
- (lexeme new-line*)
-
- one-of
- (fn [cs] (lexeme (one-of* cs)))
-
- none-of
- (fn [cs] (lexeme (none-of* cs)))
-
- token
- (if (:case-sensitive rec)
- (fn ([cs] (lexeme (token* cs)))
- ([cs & more] (lexeme (apply token* cs more))))
- (fn ([cs] (lexeme (token- cs)))
- ([cs & more] (lexeme (apply token- cs more)))))
-
- word
- (let [il (:identifier-letter rec)]
- (if (:case-sensitive rec)
- (fn ([cs] (lexeme (word* il cs)))
- ([cs & more] (lexeme (apply word* il cs more))))
- (fn ([cs] (lexeme (word- il cs)))
- ([cs & more] (lexeme (apply word- il cs more))))))
-
- identifier
- (let [start (:identifier-start rec)
- other (:identifier-letter rec)
- names (:reserved-names rec)
- elem? (fn [s coll] (member? (lower-case s) (map #(lower-case %) coll)))
- is-in (if (:case-sensitive rec) member? elem?)
- check (fn [p] (>>= p (fn [s] (if (is-in s names)
- (fail (fmt :reserved s))
- (return s)))))
- t (:type rec)]
- (cond (= t :basic) (<:> (check (lexeme (<+> start (many0 other)))))
- (= t :C) (<:> (check (lexeme (<+> start (many0 other)))))
- (= t :Haskell) (<:> (check (lexeme (<+> start (many0 other)))))
- (= t :Java) (<:> (check (lexeme (<+> start (many0 other)))))
- (= t :Shell) (<:> (check (lexeme (<+> start (many0 other)))))))
-
- field
- (fn [cs] (lexeme (field* cs)))
-
- char-lit
- (let [t (:type rec)]
- (cond (= t :basic) (char-parser lexeme basic-char)
- (= t :C) (char-parser lexeme c-char)
- (= t :Haskell) (char-parser lexeme haskell-char)
- (= t :Java) (char-parser lexeme java-char)
- (= t :Shell) (char-parser lexeme c-char)))
-
- string-lit
- (let [t (:type rec)]
- (cond (= t :basic) (str-parser lexeme basic-char)
- (= t :C) (<+> (many1 (str-parser lexeme c-char)))
- (= t :Haskell) (str-parser lexeme haskell-char)
- (= t :Java) (str-parser lexeme java-char)
- (= t :Shell) (<+> (many1 (str-parser lexeme c-char)))))
-
- dec-lit
- (let [lead (if (:leading-sign rec) sign (return nil))]
- ( (>>= (<:> (lexeme (<+> lead (many1 digit) int-suffix)))
- (fn [x] (return (read-string x))))
- (i18n :dec-lit)))
-
- oct-lit
- (let [lead (if (:leading-sign rec) sign (return nil))]
- ( (>>= (<:> (lexeme (<+> lead (sym* \0) (many oct-digit) int-suffix)))
- (fn [x] (return (read-string x))))
- (i18n :oct-lit)))
-
- hex-lit
- (let [lead (if (:leading-sign rec) sign (return nil))]
- ( (>>= (<:> (lexeme (<+> lead (token- "0x") (many1 hex-digit) int-suffix)))
- (fn [x] (return (read-string x))))
- (i18n :hex-lit)))
-
- float-lit
- (let [lead (if (:leading-sign rec) sign (return nil))]
- ( (>>= (<:> (lexeme
- (<+> lead (many1 digit)
- (option ".0" (<*> (sym* \.) (many1 digit)))
- (optional (<*> (one-of* "eE") sign (many1 digit)))
- float-suffix)))
- (fn [x] (>> (return (read-string x)) clear-empty)))
- (i18n :float-lit)))
-
- bool-lit
- (<|> (>> (word "true") (return true))
- (>> (word "false") (return false)))
-
- nil-lit
- (>> (word "nil" "null") (return nil))
-
- parens
- (fn [p] (between (sym \() (sym \)) (lexeme p)))
-
- braces
- (fn [p] (between (sym \{) (sym \}) (lexeme p)))
-
- angles
- (fn [p] (between (sym \<) (sym \>) (lexeme p)))
-
- brackets
- (fn [p] (between (sym \[) (sym \]) (lexeme p)))
-
- semi
- (sym \;)
-
- comma
- (sym \,)
-
- colon
- (sym \:)
-
- dot
- (sym \.)
-
- semi-sep
- (fn [p] (sep-by semi (lexeme p)))
-
- semi-sep1
- (fn [p] (sep-by1 semi (lexeme p)))
-
- comma-sep
- (fn [p] (sep-by comma (lexeme p)))
-
- comma-sep1
- (fn [p] (sep-by1 comma (lexeme p)))]
-
- (map->TokenParsers
- {:trim trim
- :lexeme lexeme
- :sym sym
- :new-line new-line
- :one-of one-of
- :none-of none-of
- :token token
- :word word
- :identifier identifier
- :field field
- :char-lit char-lit
- :string-lit string-lit
- :dec-lit dec-lit
- :oct-lit oct-lit
- :hex-lit hex-lit
- :float-lit float-lit
- :bool-lit bool-lit
- :nil-lit nil-lit
- :parens parens
- :braces braces
- :angles angles
- :brackets brackets
- :semi semi
- :comma comma
- :colon colon
- :dot dot
- :semi-sep semi-sep
- :semi-sep1 semi-sep1
- :comma-sep comma-sep
- :comma-sep1 comma-sep1})))
diff --git a/src/main/clojure/blancas/kern/lexer.cljc b/src/main/clojure/blancas/kern/lexer.cljc
new file mode 100644
index 0000000..8433060
--- /dev/null
+++ b/src/main/clojure/blancas/kern/lexer.cljc
@@ -0,0 +1,747 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns ^{:doc "The Kern Lexer library."
+ :author "Armando Blancas"}
+blancas.kern.lexer
+ (:require [blancas.kern.core :refer [<|> >> >>= <:> <+> << <*>] :as k]
+ [blancas.kern.i18n :refer [i18n fmt]]
+ [clojure.string :refer [lower-case]])
+ #?(:cljs (:require-macros [blancas.kern.core :as k])))
+
+
+;; +-------------------------------------------------------------+
+;; | Language definitions. |
+;; +-------------------------------------------------------------+
+
+
+;; A language def record customizes the parsers returned by make-parsers.
+(defrecord LanguageDef
+ [type ;; Identifies the type of settings.
+ comment-start ;; A string that marks the start of a block comment.
+ comment-end ;; A string that marks the end of a block comment.
+ comment-line ;; A string that marks the start of a line comment.
+ nested-comments ;; Whether the lexer accepts nested comments; a boolean.
+ identifier-start ;; A parser for the start of an identifier.
+ identifier-letter ;; A parser for the subsequent characters of an identifier.
+ reserved-names ;; A list of names that cannot be identifiers.
+ case-sensitive ;; Whether tokens are case-sensitive; a boolean.
+ line-continuation ;; A parser for the token that precedes the new line.
+ trim-newline ;; Treats newline character(s) as whitespace.
+ leading-sign]) ;; Whether numbers accept an optional leading sign.
+
+
+(def basic-def
+ "The most basic record; for use to build new styles."
+ (map->LanguageDef
+ {:type :basic
+ :comment-start ""
+ :comment-end ""
+ :comment-line ""
+ :nested-comments false
+ :identifier-start (<|> k/letter (k/sym* \_))
+ :identifier-letter (<|> k/alpha-num (k/sym* \_))
+ :reserved-names []
+ :case-sensitive true
+ :line-continuation (k/sym* \\)
+ :trim-newline true
+ :leading-sign true}))
+
+
+(def haskell-style-def
+ "Lexical settings for Haskell-style languages."
+ (assoc basic-def
+ :type :Haskell
+ :comment-start "{-"
+ :comment-end "-}"
+ :comment-line "--"
+ :nested-comments true))
+
+
+(def java-style-def
+ "Lexical settings for Java-style languages."
+ (assoc basic-def
+ :type :Java
+ :comment-start "/*"
+ :comment-end "*/"
+ :comment-line "//"))
+
+
+(def c-style-def
+ "Lexical settings for C-style languages."
+ (assoc java-style-def
+ :type :C))
+
+
+(def shell-style-def
+ "Lexical settings for shell-style languages."
+ (assoc basic-def
+ :type :Shell
+ :comment-line "#"
+ :identifier-letter (<|> k/alpha-num (k/one-of* "_-."))
+ :trim-newline false))
+
+
+;; +-------------------------------------------------------------+
+;; | Parser definitions. |
+;; +-------------------------------------------------------------+
+
+
+(defrecord TokenParsers
+ [trim
+ lexeme
+ sym
+ new-line
+ one-of
+ none-of
+ token
+ word
+ identifier
+ field
+ char-lit
+ string-lit
+ dec-lit
+ oct-lit
+ hex-lit
+ float-lit
+ bool-lit
+ nil-lit
+ parens
+ braces
+ angles
+ brackets
+ semi
+ comma
+ colon
+ dot
+ semi-sep
+ semi-sep1
+ comma-sep
+ comma-sep1])
+
+
+(k/defn* trim
+ "Skips over any whitespace, including comments (if defined), at
+ the start of the input. Whether newline characters are removed
+ as whitespace is configured by :trim-newline. When that setting
+ is true, the setting :line-continuation is activated."
+ [] nil)
+
+(k/defn* lexeme
+ "Applies parser p, then calls (trim)."
+ [p] nil)
+
+(k/defn* sym
+ "Parses a single character c. Compares according to
+ :case-sensitive. Calls (trim) afterwards."
+ [c] nil)
+
+(k/defn* new-line
+ "Parses a new line, UNIX or Windows style; then calls (trim)."
+ [] nil)
+
+(k/defn* one-of
+ "Succeeds if the next character is in the supplied string.
+ Calls (trim) afterwards."
+ [cs] nil)
+
+(k/defn* none-of
+ "Succeeds if the next character is not in the supplied string.
+ Calls (trim) afterwards."
+ [] nil)
+
+(k/defn* token
+ "Parses a specific string, not necessarily delimited. If more
+ than one are given it will try each choice in turn. Compares
+ according to :case-sensitive. Calls (trim) afterwards."
+ ([cs] nil)
+ ([cs & more] nil))
+
+(k/defn* word
+ "Parses a specific string; must be delimited by any character not
+ parsed by :identifier-letter. If more than one are given it will
+ try each choice in turn. Compares according to :case-sensitive.
+ Calls (trim) afterwards."
+ ([cs] nil)
+ ([cs & more] nil))
+
+(k/defn* identifier
+ "Parses an unquoted string suitable for an identifier or a name.
+ The start of the input is defined by :identifier-start, and
+ subsequent symbols by :identtifier-letter. It will check that
+ the parsed value not be in the list of :reserved-names, if any,
+ comparing according to :case-sensitive. Calls (trim) afterwards."
+ [] nil)
+
+(k/defn* field
+ "Parses an unquoted text field terminated by any character
+ in cs. Calls (trim) afterwards."
+ [cs] nil)
+
+(k/defn* char-lit
+ "Parses a character literal according to the :type setting. The
+ common syntax is a symbol in single quotes with the usual
+ escape codes. Calls (trim) afterwards.
+
+ The following styles add escaped characters:
+
+ :basic \\b \\t \\n \\f \\r \\' \\\" \\/
+ :C :basic + \\0ooo \\0xnn \\unnnnnnnn
+ :Haskell :basic + \\nnnn \\onnnn \\xnnnn
+ :Java :basic + \\0ooo \\unnnn
+ :Shell :basic + \\0ooo \\0xnn \\unnnnnnnn"
+ [] nil)
+
+(k/defn* string-lit
+ "Parses a string literal according to the :type setting. The
+ common syntax is any number of symbols in double quotes
+ with the usual escape codes. Calls (trim) afterward.
+
+ The following styles add escaped characters:
+
+ :basic \\b \\t \\n \\f \\r \\' \\\" \\/
+ :C :basic + \\0ooo \\0xnn \\unnnnnnnn
+ :Haskell :basic + \\nnnn \\onnnn \\xnnnn
+ :Java :basic + \\0ooo \\unnnn
+ :Shell :basic + \\0ooo \\0xnn \\unnnnnnnn"
+ [] nil)
+
+(k/defn* dec-lit
+ "Parses a decimal number as Long or BigInt depending on the
+ magnitude or if it ends with N. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* oct-lit
+ "Parses an octal number as Long or BigInt depending on the
+ magnitude or if it ends with N. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* hex-lit
+ "Parses a hexadecimal number as Long or BigInt depending on the
+ magnitude or if it ends with N. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* float-lit
+ "Parses a floating-point number as Double or BigDecimal depending
+ on the magnitude or if it ends with M. It cannot start with a
+ period. The first period found must be followed by at least one
+ digit. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* bool-lit
+ "Parses a boolean value, true or false, comparing according to
+ :case-sensitive. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* nil-lit
+ "Parses a null value, nil or null, comparing according to
+ :case-sensitive. Calls (trim) afterward."
+ [] nil)
+
+(k/defn* parens
+ "Applies parser p skiping over surrounding parenthesis.
+ Calls (trim) after the opening paren, after p, and after
+ the closing paren."
+ [p] nil)
+
+(k/defn* braces
+ "Applies parser p skiping over surrounding braces.
+ Calls (trim) after the opening brace, after p, and after
+ the closing brace."
+ [p] nil)
+
+(k/defn* angles
+ "Applies parser p skiping over surrounding angle brackets.
+ Calls (trim) after the opening bracket, after p, and after
+ the closing bracket."
+ [p] nil)
+
+(k/defn* brackets
+ "Applies parser p skiping over surrounding brackets.
+ Calls (trim) after the opening bracket, after p, and after
+ the closing bracket."
+ [p] nil)
+
+(k/defn* semi
+ "Parses a single semicolon; then calls (trim)."
+ [] nil)
+
+(k/defn* comma
+ "Parses a single comma; then calls (trim)."
+ [] nil)
+
+(k/defn* colon
+ "Parses a single colon; then calls (trim)."
+ [] nil)
+
+(k/defn* dot
+ "Parses a single dot; then calls (trim)."
+ [] nil)
+
+(k/defn* semi-sep
+ "Applies parser p zero or more times, skiping over separating
+ semicolons. Calls (trim) after each p and semicolon."
+ [] nil)
+
+(k/defn* semi-sep1
+ "Applies parser p one or more times, skiping over separating
+ semicolons. Calls (trim) after each p and semicolon."
+ [] nil)
+
+(k/defn* comma-sep
+ "Applies parser p zero or more times, skiping over separating
+ commas. Calls (trim) after each p and comma."
+ [] nil)
+
+(k/defn* comma-sep1
+ "Applies parser p one or more times, skiping over separating
+ commas. Calls (trim) after each p and comma."
+ [] nil)
+
+
+#?(:clj
+ (defmacro with-parsers
+ "Binds the parser vars in the kern.lexer namespace to the values in rec."
+ [rec & body]
+ (list 'binding
+ ['blancas.kern.lexer/trim (list :trim rec)
+ 'blancas.kern.lexer/lexeme (list :lexeme rec)
+ 'blancas.kern.lexer/sym (list :sym rec)
+ 'blancas.kern.lexer/new-line (list :new-line rec)
+ 'blancas.kern.lexer/one-of (list :one-of rec)
+ 'blancas.kern.lexer/none-of (list :none-of rec)
+ 'blancas.kern.lexer/token (list :token rec)
+ 'blancas.kern.lexer/word (list :word rec)
+ 'blancas.kern.lexer/identifier (list :identifier rec)
+ 'blancas.kern.lexer/field (list :field rec)
+ 'blancas.kern.lexer/char-lit (list :char-lit rec)
+ 'blancas.kern.lexer/string-lit (list :string-lit rec)
+ 'blancas.kern.lexer/dec-lit (list :dec-lit rec)
+ 'blancas.kern.lexer/oct-lit (list :oct-lit rec)
+ 'blancas.kern.lexer/hex-lit (list :hex-lit rec)
+ 'blancas.kern.lexer/float-lit (list :float-lit rec)
+ 'blancas.kern.lexer/bool-lit (list :bool-lit rec)
+ 'blancas.kern.lexer/nil-lit (list :nil-lit rec)
+ 'blancas.kern.lexer/parens (list :parens rec)
+ 'blancas.kern.lexer/braces (list :braces rec)
+ 'blancas.kern.lexer/angles (list :angles rec)
+ 'blancas.kern.lexer/brackets (list :brackets rec)
+ 'blancas.kern.lexer/semi (list :semi rec)
+ 'blancas.kern.lexer/comma (list :comma rec)
+ 'blancas.kern.lexer/colon (list :colon rec)
+ 'blancas.kern.lexer/dot (list :dot rec)
+ 'blancas.kern.lexer/semi-sep (list :semi-sep rec)
+ 'blancas.kern.lexer/semi-sep1 (list :semi-sep1 rec)
+ 'blancas.kern.lexer/comma-sep (list :comma-sep rec)
+ 'blancas.kern.lexer/comma-sep1 (list :comma-sep1 rec)]
+ (cons 'do body))))
+
+
+;; +-------------------------------------------------------------+
+;; | Private functions for whitespace. |
+;; +-------------------------------------------------------------+
+
+
+(defn line-comment
+ "Parses a line comment."
+ [rec]
+ (let [start (:comment-line rec)]
+ (>>= (k/token* start)
+ (fn [_] (>>= (k/many-till k/any-char (<|> k/new-line* k/eof))
+ (fn [_] (k/return nil)))))))
+
+
+(defn block-nested
+ "Parses the contents and end of a nested block comment."
+ [rec]
+ (let [start (:comment-start rec)
+ end (:comment-end rec)]
+ (k/expect (k/many-till (<|> (>>= (<:> (k/token* start)) (fn [_] (block-nested rec)))
+ k/any-char)
+ (k/token* end))
+ (i18n :end-comment))))
+
+
+(defn block-rest
+ "Parses the contents and end of a block comment."
+ [rec]
+ (let [end (:comment-end rec)]
+ (k/expect (k/many-till k/any-char (k/token* end)) (i18n :end-comment))))
+
+
+(defn block-comment
+ "Parses a block comment."
+ [rec]
+ (let [start (:comment-start rec)
+ nest? (:nested-comments rec)]
+ (k/skip (<:> (k/token* start))
+ (if nest? (block-nested rec) (block-rest rec)))))
+
+
+;; +-------------------------------------------------------------+
+;; | Private functions for character and string literals. |
+;; +-------------------------------------------------------------+
+
+
+(def space-ascii 32)
+
+
+(def esc-char
+ "Parses an escape code for a basic char."
+ (let [codes (zipmap "btnfr'\"\\/" "\b\t\n\f\r'\"\\/")]
+ (>>= ( (k/one-of* "btnfr'\"\\/") (i18n :esc-code))
+ (fn [x] (k/return (get codes x))))))
+
+(defn char-code [c]
+ #?(:clj (int c)
+ :cljs (.charCodeAt c 0)))
+
+
+(defn basic-char
+ "Parses an unquoted character literal. Character c must be escaped."
+ [c]
+ ( (<|> (k/satisfy #(and (not= % c) (not= % \\) (>= (char-code %) space-ascii)))
+ (>> (k/sym* \\) esc-char))
+ (i18n :char-lit)))
+
+
+(def esc-oct
+ "Parses an octal escape code; the result is the encoded char."
+ (>>= (<+> (k/many1 k/oct-digit))
+ (fn [x]
+ (let [n #?(:clj (Integer/parseInt x 8) :cljs (js/parseInt x 8))]
+ (if (<= n 0377)
+ (k/return (char n))
+ (k/fail (i18n :bad-octal)))))))
+
+
+(def esc-uni
+ "Parses a unicode escape code; the result is the encoded char."
+ (>>= (<+> (>> (k/sym* \u) (k/times 4 k/hex-digit)))
+ (fn [x] (k/return (aget #?(:clj (Character/toChars (Integer/parseInt x 16))
+ :cljs (.fromCodePoint js/String (js/parseInt x 16))) 0)))))
+
+
+(defn java-char
+ "Parses an unquoted Java character literal. Character c must be escaped."
+ [c]
+ ( (<|> (k/satisfy #(and (not= % c) (not= % \\) (>= (char-code %) space-ascii)))
+ (>> (k/sym* \\)
+ ( (<|> esc-char esc-oct esc-uni)
+ (i18n :esc-code-j))))
+ (i18n :char-lit)))
+
+
+(def c-esc-char
+ "Parses an escape code for a C char."
+ (let [codes (assoc (zipmap "btnfr'\"\\?/" "\b\t\n\f\r'\"\\?/")
+ \a (char 7) \v (char 11) \0 (char 0))]
+ (>>= (k/one-of* "btnfr'\"\\?/av0") (fn [x] (k/return (get codes x))))))
+
+
+(def c-esc-uni
+ "Parses a long unicode escape code; the result is the encoded char."
+ (>>= (<+> (>> (k/sym* \U) (k/times 8 k/hex-digit)))
+ (fn [x] (k/return (aget #?(:clj (Character/toChars (Integer/parseInt x 16))
+ :cljs (.fromCodePoint js/String (js/parseInt x 16))) 0)))))
+
+
+(def c-esc-hex
+ "Parses a hex escape code; the result is the encoded char."
+ (>>= (<+> (>> (k/sym- \x) (k/times 2 k/hex-digit)))
+ (fn [x] (k/return (aget #?(:clj (Character/toChars (Integer/parseInt x 16))
+ :cljs (.fromCodePoint js/String (js/parseInt x 16))) 0)))))
+
+
+(defn c-char
+ "Parses an unquoted C character literal. Character c must be escaped."
+ [c]
+ ( (<|> (k/satisfy #(and (not= % c) (not= % \\) (>= (char-code %) space-ascii)))
+ (>> (k/sym* \\)
+ ( (<|> c-esc-hex c-esc-char esc-oct esc-uni c-esc-uni)
+ (i18n :esc-code-c))))
+ (i18n :char-lit)))
+
+
+(def h-esc-oct
+ "Parses a Haskell octal escape code; the result is the encoded char."
+ (>>= (<+> (>> (k/sym* \o) (k/many1 k/oct-digit)))
+ (fn [x]
+ (let [n #?(:clj (Integer/parseInt x 8) :cljs (js/parseInt x 8))]
+ (if (<= n 04177777)
+ (k/return (char n))
+ (k/fail (i18n :bad-oct-h)))))))
+
+
+(def h-esc-dec
+ "Parses a Haskell decimal escape code; the result is the encoded char."
+ (>>= (<+> (k/many1 k/digit))
+ (fn [x]
+ (let [n #?(:clj (Integer/parseInt x) :cljs (js/parseInt x))]
+ (if (<= n 1114111)
+ (k/return (char n))
+ (k/fail (i18n :bad-dec-h)))))))
+
+
+(def h-esc-hex
+ "Parses a Haskell hex escape code; the result is the encoded char."
+ (>>= (<+> (>> (k/sym* \x) (k/many1 k/hex-digit)))
+ (fn [x]
+ (let [n #?(:clj (Integer/parseInt x 16) :cljs (js/parseInt x 16))]
+ (if (<= n 0x10ffff)
+ (k/return (char n))
+ (k/fail (i18n :bad-hex-h)))))))
+
+
+(defn haskell-char
+ "Parses Haskell character literals."
+ [c]
+ ( (<|> (k/satisfy #(and (not= % c) (not= % \\) (>= (char-code %) space-ascii)))
+ (>> (k/sym* \\)
+ ( (<|> h-esc-hex h-esc-oct c-esc-char h-esc-dec)
+ (i18n :esc-code-h))))
+ (i18n :char-lit)))
+
+
+(defn char-parser
+ "Parses character literals delimited by single quotes."
+ [lex f]
+ ( (lex (k/between (k/sym* \') ( (k/sym* \') (i18n :end-char)) (f \')))
+ (i18n :char-lit)))
+
+
+(defn str-parser
+ "Parses string literals delimited by double quotes."
+ [lex f]
+ ( (lex (k/between (k/sym* \")
+ ( (k/sym* \") (i18n :end-string))
+ (<+> (k/many (f \")))))
+ (i18n :string-lit)))
+
+
+;; +-------------------------------------------------------------+
+;; | Private functions for numeric literals. |
+;; +-------------------------------------------------------------+
+
+
+(def sign (k/optional (k/one-of* "+-")))
+
+(def int-suffix (<|> (<< #?(:clj (k/sym* \N) :cljs (k/skip (k/sym* \N))) (k/not-followed-by k/letter))
+ (k/not-followed-by (<|> k/letter (k/sym* \.)))))
+
+(def float-suffix (<< (k/optional #?(:clj (k/sym* \M) :cljs (k/skip (k/sym* \M)))) (k/not-followed-by k/letter)))
+
+
+;; +-------------------------------------------------------------+
+;; | Parser generator. |
+;; +-------------------------------------------------------------+
+
+(defn read-num-lit [x]
+ #?(:clj (read-string x)
+ :cljs (js/eval x)))
+
+(defn make-parsers
+ "Returns a function map that corresponds to the customization
+ values of the input record, whose fields are as follows:
+
+ :type Identifies the type of settings.
+ :comment-start A string that marks the start of a block comment.
+ :comment-end A string that marks the end of a block comment.
+ :comment-line A string that marks the start of a line comment.
+ :nested-comments Whether the lexer accepts nested comments; a boolean.
+ :identifier-start A parser for the start of an identifier.
+ :identifier-letter A parser for the subsequent characters of an identifier.
+ :reserved-names A list of names that cannot be identifiers.
+ :case-sensitive Whether tokens are case-sensitive; a boolean.
+ :line-continuation A parser for the token that precedes the new line.
+ :trim-newline Treats newline character(s) as whitespace.
+ :leading-sign Whether numbers accept an optional leading sign."
+ [rec]
+ (let [trim
+ (let [line? (seq (:comment-line rec))
+ multi? (seq (:comment-start rec))
+ both? (and line? multi?)
+ ws (if (:trim-newline rec)
+ k/white-space
+ (<|> (k/one-of* "\t\f\r ")
+ (k/skip (:line-continuation rec) k/new-line*)))
+ many-ws (k/skip-many1 ws)]
+ (cond both? (k/skip-many (<|> many-ws (line-comment rec) (block-comment rec)))
+ line? (k/skip-many (<|> many-ws (line-comment rec)))
+ multi? (k/skip-many (<|> many-ws (block-comment rec)))
+ :else (k/skip-many ws)))
+
+ lexeme
+ (fn [p] (<< p trim))
+
+ sym
+ (if (:case-sensitive rec)
+ (fn [x] (lexeme (k/sym* x)))
+ (fn [x] (lexeme (k/sym- x))))
+
+ new-line
+ (lexeme k/new-line*)
+
+ one-of
+ (fn [cs] (lexeme (k/one-of* cs)))
+
+ none-of
+ (fn [cs] (lexeme (k/none-of* cs)))
+
+ token
+ (if (:case-sensitive rec)
+ (fn ([cs] (lexeme (k/token* cs)))
+ ([cs & more] (lexeme (apply k/token* cs more))))
+ (fn ([cs] (lexeme (k/token- cs)))
+ ([cs & more] (lexeme (apply k/token- cs more)))))
+
+ word
+ (let [il (:identifier-letter rec)]
+ (if (:case-sensitive rec)
+ (fn ([cs] (lexeme (k/word* il cs)))
+ ([cs & more] (lexeme (apply k/word* il cs more))))
+ (fn ([cs] (lexeme (k/word- il cs)))
+ ([cs & more] (lexeme (apply k/word- il cs more))))))
+
+ identifier
+ (let [start (:identifier-start rec)
+ other (:identifier-letter rec)
+ names (:reserved-names rec)
+ elem? (fn [s coll] (k/member? (lower-case s) (map #(lower-case %) coll)))
+ is-in (if (:case-sensitive rec) k/member? elem?)
+ check (fn [p] (>>= p (fn [s] (if (is-in s names)
+ (k/fail (fmt :reserved s))
+ (k/return s)))))
+ t (:type rec)]
+ (cond (= t :basic) (<:> (check (lexeme (<+> start (k/many0 other)))))
+ (= t :C) (<:> (check (lexeme (<+> start (k/many0 other)))))
+ (= t :Haskell) (<:> (check (lexeme (<+> start (k/many0 other)))))
+ (= t :Java) (<:> (check (lexeme (<+> start (k/many0 other)))))
+ (= t :Shell) (<:> (check (lexeme (<+> start (k/many0 other)))))))
+
+ field
+ (fn [cs] (lexeme (k/field* cs)))
+
+ char-lit
+ (let [t (:type rec)]
+ (cond (= t :basic) (char-parser lexeme basic-char)
+ (= t :C) (char-parser lexeme c-char)
+ (= t :Haskell) (char-parser lexeme haskell-char)
+ (= t :Java) (char-parser lexeme java-char)
+ (= t :Shell) (char-parser lexeme c-char)))
+
+ string-lit
+ (let [t (:type rec)]
+ (cond (= t :basic) (str-parser lexeme basic-char)
+ (= t :C) (<+> (k/many1 (str-parser lexeme c-char)))
+ (= t :Haskell) (str-parser lexeme haskell-char)
+ (= t :Java) (str-parser lexeme java-char)
+ (= t :Shell) (<+> (k/many1 (str-parser lexeme c-char)))))
+
+ dec-lit
+ (let [lead (if (:leading-sign rec) sign (k/return nil))]
+ ( (>>= (<:> (lexeme (<+> lead (k/many1 k/digit) int-suffix)))
+ (fn [x] (k/return (read-num-lit x))))
+ (i18n :dec-lit)))
+
+ oct-lit
+ (let [lead (if (:leading-sign rec) sign (k/return nil))]
+ ( (>>= (<:> (lexeme (<+> lead (k/sym* \0) (k/many k/oct-digit) int-suffix)))
+ (fn [x] (k/return (read-num-lit x))))
+ (i18n :oct-lit)))
+
+ hex-lit
+ (let [lead (if (:leading-sign rec) sign (k/return nil))]
+ ( (>>= (<:> (lexeme (<+> lead (k/token- "0x") (k/many1 k/hex-digit) int-suffix)))
+ (fn [x] (k/return (read-num-lit x))))
+ (i18n :hex-lit)))
+
+ float-lit
+ (let [lead (if (:leading-sign rec) sign (k/return nil))]
+ ( (>>= (<:> (lexeme
+ (<+> lead (k/many1 k/digit)
+ (k/option ".0" (<*> (k/sym* \.) (k/many1 k/digit)))
+ (k/optional (<*> (k/one-of* "eE") sign (k/many1 k/digit)))
+ float-suffix)))
+ (fn [x] (>> (k/return (read-num-lit x)) k/clear-empty)))
+ (i18n :float-lit)))
+
+ bool-lit
+ (<|> (>> (word "true") (k/return true))
+ (>> (word "false") (k/return false)))
+
+ nil-lit
+ (>> (word "nil" "null") (k/return nil))
+
+ parens
+ (fn [p] (k/between (sym \() (sym \)) (lexeme p)))
+
+ braces
+ (fn [p] (k/between (sym \{) (sym \}) (lexeme p)))
+
+ angles
+ (fn [p] (k/between (sym \<) (sym \>) (lexeme p)))
+
+ brackets
+ (fn [p] (k/between (sym \[) (sym \]) (lexeme p)))
+
+ semi
+ (sym \;)
+
+ comma
+ (sym \,)
+
+ colon
+ (sym \:)
+
+ dot
+ (sym \.)
+
+ semi-sep
+ (fn [p] (k/sep-by semi (lexeme p)))
+
+ semi-sep1
+ (fn [p] (k/sep-by1 semi (lexeme p)))
+
+ comma-sep
+ (fn [p] (k/sep-by comma (lexeme p)))
+
+ comma-sep1
+ (fn [p] (k/sep-by1 comma (lexeme p)))]
+
+ (map->TokenParsers
+ {:trim trim
+ :lexeme lexeme
+ :sym sym
+ :new-line new-line
+ :one-of one-of
+ :none-of none-of
+ :token token
+ :word word
+ :identifier identifier
+ :field field
+ :char-lit char-lit
+ :string-lit string-lit
+ :dec-lit dec-lit
+ :oct-lit oct-lit
+ :hex-lit hex-lit
+ :float-lit float-lit
+ :bool-lit bool-lit
+ :nil-lit nil-lit
+ :parens parens
+ :braces braces
+ :angles angles
+ :brackets brackets
+ :semi semi
+ :comma comma
+ :colon colon
+ :dot dot
+ :semi-sep semi-sep
+ :semi-sep1 semi-sep1
+ :comma-sep comma-sep
+ :comma-sep1 comma-sep1})))
diff --git a/src/main/clojure/blancas/kern/lexer/basic.clj b/src/main/clojure/blancas/kern/lexer/basic.cljc
similarity index 94%
rename from src/main/clojure/blancas/kern/lexer/basic.clj
rename to src/main/clojure/blancas/kern/lexer/basic.cljc
index 8a07229..144fee1 100644
--- a/src/main/clojure/blancas/kern/lexer/basic.clj
+++ b/src/main/clojure/blancas/kern/lexer/basic.cljc
@@ -22,10 +22,10 @@ line-continuation Backslash
trim-newline Yes"
:author "Armando Blancas"}
blancas.kern.lexer.basic
- (:use [blancas.kern.core])
- (:require [blancas.kern.lexer :as lex]))
+ (:require [blancas.kern.core :as k]
+ [blancas.kern.lexer :as lex]))
-(def- rec (lex/make-parsers lex/basic-def))
+(def rec (lex/make-parsers lex/basic-def))
(def trim (:trim rec))
(def lexeme (:lexeme rec))
diff --git a/src/main/clojure/blancas/kern/lexer/c_style.clj b/src/main/clojure/blancas/kern/lexer/c_style.cljc
similarity index 94%
rename from src/main/clojure/blancas/kern/lexer/c_style.clj
rename to src/main/clojure/blancas/kern/lexer/c_style.cljc
index 064cb95..0efb23f 100644
--- a/src/main/clojure/blancas/kern/lexer/c_style.clj
+++ b/src/main/clojure/blancas/kern/lexer/c_style.cljc
@@ -24,10 +24,10 @@ trim-newline Yes
Literal values follow the rules of the C programming language."
:author "Armando Blancas"}
blancas.kern.lexer.c-style
- (:use [blancas.kern.core])
- (:require [blancas.kern.lexer :as lex]))
+ (:require [blancas.kern.core :as k]
+ [blancas.kern.lexer :as lex]))
-(def- rec (lex/make-parsers lex/c-style))
+(def rec (lex/make-parsers lex/c-style-def))
(def trim (:trim rec))
(def lexeme (:lexeme rec))
diff --git a/src/main/clojure/blancas/kern/lexer/haskell_style.clj b/src/main/clojure/blancas/kern/lexer/haskell_style.cljc
similarity index 93%
rename from src/main/clojure/blancas/kern/lexer/haskell_style.clj
rename to src/main/clojure/blancas/kern/lexer/haskell_style.cljc
index ed3d3f4..f4e6626 100644
--- a/src/main/clojure/blancas/kern/lexer/haskell_style.clj
+++ b/src/main/clojure/blancas/kern/lexer/haskell_style.cljc
@@ -24,10 +24,10 @@ trim-newline Yes
Literal values follow the rules of the Haskell programming language."
:author "Armando Blancas"}
blancas.kern.lexer.haskell-style
- (:use [blancas.kern.core])
- (:require [blancas.kern.lexer :as lex]))
+ (:require [blancas.kern.core :as k]
+ [blancas.kern.lexer :as lex]))
-(def- rec (lex/make-parsers lex/haskell-style))
+(def rec (lex/make-parsers lex/haskell-style-def))
(def trim (:trim rec))
(def lexeme (:lexeme rec))
diff --git a/src/main/clojure/blancas/kern/lexer/java_style.clj b/src/main/clojure/blancas/kern/lexer/java_style.cljc
similarity index 94%
rename from src/main/clojure/blancas/kern/lexer/java_style.clj
rename to src/main/clojure/blancas/kern/lexer/java_style.cljc
index 9c0abb1..2f48e76 100644
--- a/src/main/clojure/blancas/kern/lexer/java_style.clj
+++ b/src/main/clojure/blancas/kern/lexer/java_style.cljc
@@ -24,10 +24,10 @@ trim-newline Yes
Literal values follow the rules of the Java programming language."
:author "Armando Blancas"}
blancas.kern.lexer.java-style
- (:use [blancas.kern.core])
- (:require [blancas.kern.lexer :as lex]))
+ (:require [blancas.kern.core :as k]
+ [blancas.kern.lexer :as lex]))
-(def- rec (lex/make-parsers lex/java-style))
+(def rec (lex/make-parsers lex/java-style-def))
(def trim (:trim rec))
(def lexeme (:lexeme rec))
diff --git a/src/main/clojure/blancas/kern/lexer/shell_style.clj b/src/main/clojure/blancas/kern/lexer/shell_style.cljc
similarity index 93%
rename from src/main/clojure/blancas/kern/lexer/shell_style.clj
rename to src/main/clojure/blancas/kern/lexer/shell_style.cljc
index 60dbea1..0f78fa8 100644
--- a/src/main/clojure/blancas/kern/lexer/shell_style.clj
+++ b/src/main/clojure/blancas/kern/lexer/shell_style.cljc
@@ -22,10 +22,10 @@ line-continuation Backslash
trim-newline No"
:author "Armando Blancas"}
blancas.kern.lexer.shell-style
- (:use [blancas.kern.core])
- (:require [blancas.kern.lexer :as lex]))
+ (:require [blancas.kern.core :as k]
+ [blancas.kern.lexer :as lex]))
-(def- rec (lex/make-parsers lex/shell-style))
+(def rec (lex/make-parsers lex/shell-style-def))
(def trim (:trim rec))
(def lexeme (:lexeme rec))
diff --git a/src/main/resources/custom_lexer.clj b/src/main/resources/custom_lexer.clj
index 3ba9802..4f15987 100644
--- a/src/main/resources/custom_lexer.clj
+++ b/src/main/resources/custom_lexer.clj
@@ -15,7 +15,7 @@
:trim-newline false))
;; Then make the customized parsers.
-(def- rec (lex/make-parsers hoc-style))
+(def rec (lex/make-parsers hoc-style))
;; For easy access, store the parsers in vars.
(def trim (:trim rec))
diff --git a/src/main/resources/customhoc.clj b/src/main/resources/customhoc.clj
index 7f53a66..4fe536b 100644
--- a/src/main/resources/customhoc.clj
+++ b/src/main/resources/customhoc.clj
@@ -27,7 +27,7 @@
:trim-newline false))
;; Then make the customized parsers.
-(def- rec (lex/make-parsers hoc-style))
+(def rec (lex/make-parsers hoc-style))
;; For easy access, store the parsers in vars.
(def trim (:trim rec))
diff --git a/src/main/resources/public/index.html b/src/main/resources/public/index.html
new file mode 100644
index 0000000..fd2ddfa
--- /dev/null
+++ b/src/main/resources/public/index.html
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/src/test/clojure/blancas/kern/runnner.cljs b/src/test/clojure/blancas/kern/runnner.cljs
new file mode 100644
index 0000000..5262944
--- /dev/null
+++ b/src/test/clojure/blancas/kern/runnner.cljs
@@ -0,0 +1,18 @@
+(ns blancas.kern.runnner
+ (:require [cljs.test :as test]
+ [doo.runner :refer-macros [doo-all-tests doo-tests]]
+ [blancas.kern.test-core]
+ [blancas.kern.test-lexer]
+ [blancas.kern.test-lexer-c]
+ [blancas.kern.test-lexer-haskell]
+ [blancas.kern.test-lexer-java]
+ [blancas.kern.test-lexer-shell]))
+
+(enable-console-print!)
+
+(doo-tests 'blancas.kern.test-core
+ 'blancas.kern.test-lexer
+ 'blancas.kern.test-lexer-c
+ 'blancas.kern.test-lexer-haskell
+ 'blancas.kern.test-lexer-java
+ 'blancas.kern.test-lexer-shell)
diff --git a/src/test/clojure/blancas/kern/test_core.clj b/src/test/clojure/blancas/kern/test_core.clj
deleted file mode 100644
index 32314cf..0000000
--- a/src/test/clojure/blancas/kern/test_core.clj
+++ /dev/null
@@ -1,3441 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-core
- (:use [blancas.kern.core]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)]))
-
-;; Private functions from kern.core
-
-(def make-err-message (ns-resolve 'blancas.kern.core 'make-err-message))
-(def make-err-unexpect (ns-resolve 'blancas.kern.core 'make-err-unexpect))
-(def make-err-system (ns-resolve 'blancas.kern.core 'make-err-system))
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-(def make-pos (ns-resolve 'blancas.kern.core 'make-pos))
-
-
-;; +-------------------------------------------------------------+
-;; | Basic parsers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse letter "xyz")
- s2 ((return 0) s1)]
- (fact "return"
- (:value s2) => 0
- (:ok s2) => true
- (:error s2) => nil
- (:input s2) => (:input s1)
- (:empty s2) => (:empty s1)
- (:pos s2) => (:pos s1)
- (:user s2) => (:user s1))))
-
-
-(deftest test-0005
- (let [em "the buck stops here"
- s1 (parse letter "xyz")
- s2 ((fail em) s1)]
- (fact "fail"
- (:value s2) => nil
- (:ok s2) => false
- (:empty s2) => true
- (:error s2) => (make-err-message (:pos s1) em)
- (:input s2) => (:input s1)
- (:pos s2) => (:pos s1)
- (:user s2) => (:user s1))))
-
-
-(deftest test-0010
- (let [s1 (parse letter "xyz")
- s2 ((satisfy #(Character/isLetter %)) s1)]
- (fact "satisfy - advances one char"
- (:input s2) => [\z]
- (:value s2) => \y
- (:ok s2) => true
- (:empty s2) => false
- (:user s2) => (:user s1)
- (:error s2) => nil
- (:pos s2) => (contains {:line 1 :col 3}))))
-
-
-(deftest test-0015
- (let [s1 (parse letter "u2")
- s2 ((satisfy #(Character/isDigit %)) s1)]
- (fact "satisfy - reaches the end of input"
- (:input s2) => empty?
- (:value s2) => \2
- (:ok s2) => true
- (:empty s2) => false
- (:user s2) => (:user s1)
- (:error s2) => nil
- (:pos s2) => (contains {:line 1 :col 3}))))
-
-
-(deftest test-0020
- (let [s1 (parse letter "u\t")
- s2 ((satisfy #(= \tab %)) s1)]
- (fact "satisfy - advnaces one tab; default 4 positions"
- (:value s2) => \tab
- (:ok s2) => true
- (:empty s2) => false
- (:user s2) => (:user s1)
- (:error s2) => nil
- (:pos s2) => (contains {:line 1 :col 6}))))
-
-
-(deftest test-0025
- (binding [*tab-width* 8]
- (let [s1 (parse letter "u\t")
- s2 ((satisfy #(= \tab %)) s1)]
- (fact "satisfy - advances one tab of 8 positions"
- (:value s2) => \tab
- (:ok s2) => true
- (:empty s2) => false
- (:user s2) => (:user s1)
- (:error s2) => nil
- (:pos s2) => (contains {:line 1 :col 10})))))
-
-
-(deftest test-0030
- (let [s1 (parse letter "u\n")
- s2 ((satisfy #(= \newline %)) s1)]
- (fact "satisfy - advances to the next line, first column"
- (:value s2) => \newline
- (:ok s2) => true
- (:empty s2) => false
- (:user s2) => (:user s1)
- (:error s2) => nil
- (:pos s2) => (contains {:line 2 :col 1}))))
-
-
-(deftest test-0035
- (let [em "end of input"
- s1 (parse (many letter) "xyz")
- s2 ((satisfy (fn [_] true)) s1)]
- (fact "satisfy - attempts to read past the end of input"
- (:input s2) => empty?
- (:value s2) => nil
- (:ok s2) => false
- (:empty s2) => true
- (:user s2) => (:user s1)
- (:error s2) => (make-err-unexpect (:pos s1) em)
- (:pos s2) => (:pos s1))))
-
-
-(deftest test-0040
- (let [em "\\2"
- s1 (parse letter "u2")
- s2 ((satisfy #(Character/isLetter %)) s1)]
- (fact "satisfy - the predicate fails"
- (:input s2) => [\2]
- (:value s2) => nil
- (:ok s2) => false
- (:empty s2) => true
- (:user s2) => (:user s1)
- (:error s2) => (make-err-system (:pos s1) em)
- (:pos s2) => (:pos s1))))
-
-
-;; +-------------------------------------------------------------+
-;; | Primitive parsers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0045
- (let [in "#(f %)"
- s1 (parse any-char in)]
- (fact "any-char"
- (:input s1) => (rest in)
- (:value s1) => \#
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => (:user s1)
- (:error s1) => nil
- (:pos s1) => (contains {:line 1 :col 2}))))
-
-
-(deftest test-0050
- (let [in "xyz"
- s1 (parse (>>= any-char
- (fn [a]
- (>>= any-char
- (fn [b]
- (>>= any-char
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "any-char - three in a row"
- (:value s1) => (seq in))))
-
-
-(deftest test-0055
- (let [em "end of input"
- s1 (parse any-char "")]
- (fact "any-char - fails on end of input"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- (:user s1) => (:user s1)
- (:error s1) => (make-err-unexpect (:pos s1) em)
- (:pos s1) => (contains {:line 1 :col 1}))))
-
-
-(deftest test-0060
- (let [in "abc"
- s1 (parse letter in)]
- (fact "letter - parses a single letter"
- (:input s1) => (rest in)
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0065
- (let [in "xyz"
- s1 (parse (>>= letter
- (fn [a]
- (>>= letter
- (fn [b]
- (>>= letter
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "letter - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0070
- (let [in "123"
- s1 (parse letter in)]
- (fact "letter - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0075
- (let [in "abc"
- s1 (parse lower in)]
- (fact "lower - parses a single lower-case letter"
- (:input s1) => (rest in)
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0080
- (let [in "xyz"
- s1 (parse (>>= lower
- (fn [a]
- (>>= lower
- (fn [b]
- (>>= lower
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "lower - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0085
- (let [in "XYZ"
- s1 (parse lower in)]
- (fact "lower - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0090
- (let [in "ABC"
- s1 (parse upper in)]
- (fact "upper - parses a single upper-case letter"
- (:input s1) => (rest in)
- (:value s1) => \A
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0095
- (let [in "XYZ"
- s1 (parse (>>= upper
- (fn [a]
- (>>= upper
- (fn [b]
- (>>= upper
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "upper - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0100
- (let [in "123"
- s1 (parse upper in)]
- (fact "upper - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0105
- (let [in " \t\t"
- s1 (parse white-space in)]
- (fact "white-space - parses a single whitespace character"
- (:input s1) => (rest in)
- (:value s1) => \space
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0110
- (let [in " \t "
- s1 (parse (>>= white-space
- (fn [a]
- (>>= white-space
- (fn [b]
- (>>= white-space
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "white-space - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0115
- (let [in "***"
- s1 (parse white-space in)]
- (fact "white-space - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0120
- (let [in " "
- s1 (parse space in)]
- (fact "space - parses a single space character"
- (:input s1) => (rest in)
- (:value s1) => \space
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0125
- (let [in " "
- s1 (parse (>>= space
- (fn [a]
- (>>= space
- (fn [b]
- (>>= space
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "space - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0130
- (let [in "***"
- s1 (parse space in)]
- (fact "space - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0135
- (let [in "\n\t."
- s1 (parse new-line* in)]
- (fact "new-line - parses a single newline character"
- (:input s1) => (rest in)
- (:value s1) => \newline
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0140
- (let [in "\n\n\n"
- s1 (parse (>>= new-line*
- (fn [a]
- (>>= new-line*
- (fn [b]
- (>>= new-line*
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "new-line* - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0145
- (let [in "***"
- s1 (parse new-line* in)]
- (fact "new-line* - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0150
- (let [in "\t|\t|"
- s1 (parse tab in)]
- (fact "tab - parses a single tab character"
- (:input s1) => (rest in)
- (:value s1) => \tab
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0155
- (let [in "\t\t\t"
- s1 (parse (>>= tab
- (fn [a]
- (>>= tab
- (fn [b]
- (>>= tab
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "tab - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0160
- (let [in "***"
- s1 (parse tab in)]
- (fact "tab - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0165
- (let [in "12345"
- s1 (parse digit in)]
- (fact "digit - parses a single digit"
- (:input s1) => (rest in)
- (:value s1) => \1
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0170
- (let [in "012"
- s1 (parse (>>= digit
- (fn [a]
- (>>= digit
- (fn [b]
- (>>= digit
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "digit - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0175
- (let [in "***"
- s1 (parse digit in)]
- (fact "digit - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0180
- (let [in "ABCDEF"
- s1 (parse hex-digit in)]
- (fact "hex-digit - parses a single hex digit"
- (:input s1) => (rest in)
- (:value s1) => \A
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0185
- (let [in "CAB"
- s1 (parse (>>= hex-digit
- (fn [a]
- (>>= hex-digit
- (fn [b]
- (>>= hex-digit
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "hex-digit - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0190
- (let [in "***"
- s1 (parse digit in)]
- (fact "hex-digit - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0195
- (let [in "12345"
- s1 (parse oct-digit in)]
- (fact "oct-digit - parses a single octal digit"
- (:input s1) => (rest in)
- (:value s1) => \1
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0200
- (let [in "567"
- s1 (parse (>>= oct-digit
- (fn [a]
- (>>= oct-digit
- (fn [b]
- (>>= oct-digit
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "oct-digit - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0205
- (let [in "***"
- s1 (parse digit in)]
- (fact "oct-digit - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0210
- (let [in "a0b1"
- s1 (parse alpha-num in)]
- (fact "alpha-num - parses a single alpha-numeric character"
- (:input s1) => (rest in)
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0215
- (let [in "a1b"
- s1 (parse (>>= alpha-num
- (fn [a]
- (>>= alpha-num
- (fn [b]
- (>>= alpha-num
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "alpha-num - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0220
- (let [in "+*&"
- s1 (parse alpha-num in)]
- (fact "alpha-num - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0225
- (let [in "X()"
- s1 (parse (sym* \X) in)]
- (fact "sym* - parses a single X"
- (:input s1) => (rest in)
- (:value s1) => \X
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0230
- (let [in "p\t;"
- s1 (parse (>>= (sym* \p)
- (fn [a]
- (>>= (sym* \tab)
- (fn [b]
- (>>= (sym* \;)
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "sym* - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0235
- (let [in "***"
- s1 (parse (sym* \X) in)]
- (fact "sym* - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0235-05
- (let [in "x()"
- s1 (parse (sym- \X) in)]
- (fact "sym- - parses a single x"
- (:input s1) => (rest in)
- (:value s1) => \X
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0235-10
- (let [in "X()"
- s1 (parse (sym- \X) in)]
- (fact "sym- - parses a single X"
- (:input s1) => (rest in)
- (:value s1) => \X
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0235-15
- (let [in "A()"
- s1 (parse (sym- \X) in)
- em (get-msg-str (:error s1))]
- (fact "sym- - parses a single X"
- (:input s1) => [\A \( \)]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\A\nexpecting \\X")))
-
-
-(deftest test-0240
- (let [in "program foo()"
- s1 (parse (token* "program") in)]
- (fact "token* - parses a specific word"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0245
- (let [in "foo(bar)baz"
- s1 (parse (>>= (token* "foo")
- (fn [a]
- (>>= (token* "(bar)")
- (fn [b]
- (>>= (token* "baz")
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "token* - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => ["foo" "(bar)" "baz"])))
-
-
-(deftest test-0250
- (let [in "goat"
- s1 (parse (token* "goal") in)
- em (get-msg-str (:error s1))]
- (fact "token* - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected goat\nexpecting goal")))
-
-
-(deftest test-0250-05
- (let [in "function foo()"
- s1 (parse (token* "function" "procedure") in)]
- (fact "token* - parses one of multiple word choices"
- (:input s1) => (drop (count "function") in)
- (:value s1) => "function"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-10
- (let [in "procedure foo()"
- s1 (parse (token* "function" "procedure") in)]
- (fact "token* - parses one of multiple word choices"
- (:input s1) => (drop (count "procedure") in)
- (:value s1) => "procedure"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-15
- (let [in "program foo()"
- s1 (parse (token- "PROGRAM") in)]
- (fact "token- - parses a specific word; non case-sensetive"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "PROGRAM"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-20
- (let [in "Program foo()"
- s1 (parse (token- "PROGRAM") in)]
- (fact "token- - parses a specific word; non case-sensetive"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "PROGRAM"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-25
- (let [in "PROGRAM foo()"
- s1 (parse (token- "PROGRAM") in)]
- (fact "token- - parses a specific word; non case-sensetive"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "PROGRAM"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-30
- (let [in "goat"
- s1 (parse (token- "goal") in)
- em (get-msg-str (:error s1))]
- (fact "token- - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected goat\nexpecting goal")))
-
-
-(deftest test-0250-35
- (let [in "FUNction foo()"
- s1 (parse (token- "function" "procedure") in)]
- (fact "token- - parses one of multiple word choices"
- (:input s1) => (drop (count "function") in)
- (:value s1) => "function"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-40
- (let [in "PROCedure foo()"
- s1 (parse (token- "function" "procedure") in)]
- (fact "token- - parses one of multiple word choices"
- (:input s1) => (drop (count "procedure") in)
- (:value s1) => "procedure"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-45
- (let [in "program foo()"
- s1 (parse (word* letter "program") in)]
- (fact "word* - parses a specific, delimited word"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-50
- (let [in "else{}"
- s1 (parse (word* letter "else") in)]
- (fact "word* - parses a specific, delimited word"
- (:input s1) => [\{ \}]
- (:value s1) => "else"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-55
- (let [in "procedure"
- s1 (parse (word* letter "proc") in)
- em (get-msg-str (:error s1))]
- (fact "word* - fails because is not delimited"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected e\nexpecting end of proc")))
-
-
-(deftest test-0250-60
- (let [in "otherwise{}"
- s1 (parse (word* letter "else" "otherwise") in)]
- (fact "word* - parses a specific, delimited word"
- (:input s1) => [\{ \}]
- (:value s1) => "otherwise"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-65
- (let [in "subroutine"
- s1 (parse (word* letter "proc" "func" "method") in)
- em (get-msg-str (:error s1))]
- (fact "word* - fails with incorrect input"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected subr\nunexpected subrou\nexpecting proc, func or method")))
-
-
-(deftest test-0250-70
- (let [in "PROGRAM foo()"
- s1 (parse (word- letter "program") in)]
- (fact "word- - parses a specific, delimited word; not case-senstive"
- (:input s1) => (drop (count "program") in)
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-75
- (let [in "Else{}"
- s1 (parse (word- letter "else") in)]
- (fact "word- - parses a specific, delimited word; not case-senstive"
- (:input s1) => [\{ \}]
- (:value s1) => "else"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-80
- (let [in "ProcEdure"
- s1 (parse (word- letter "proc") in)
- em (get-msg-str (:error s1))]
- (fact "word- - fails because is not delimited"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected E\nexpecting end of proc")))
-
-
-(deftest test-0250-85
- (let [in "OtherWise{}"
- s1 (parse (word- letter "else" "otherwise") in)]
- (fact "word- - parses a specific, delimited word; not case-senstive"
- (:input s1) => [\{ \}]
- (:value s1) => "otherwise"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0250-90
- (let [in "SUBroutine"
- s1 (parse (word- letter "proc" "func" "method") in)
- em (get-msg-str (:error s1))]
- (fact "word- - fails with incorrect input"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected SUBr\nunexpected SUBrou\nexpecting proc, func or method")))
-
-
-(deftest test-0255
- (let [in "* 2"
- s1 (parse (one-of* "+-*/^") in)]
- (fact "one-of* - parses one of the supplied characters"
- (:input s1) => (rest in)
- (:value s1) => \*
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0260
- (let [in "*-+"
- op "+-*/"
- s1 (parse (>>= (one-of* op)
- (fn [a]
- (>>= (one-of* op)
- (fn [b]
- (>>= (one-of* op)
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "one-of* - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0265
- (let [in "abc"
- s1 (parse (one-of* "+-*/") in)]
- (fact "one-of* - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0270
- (let [in ": 2"
- s1 (parse (none-of* "+-*/^") in)]
- (fact "none-of* - parses a character not supplied"
- (:input s1) => (rest in)
- (:value s1) => \:
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0275
- (let [in "^&%"
- op "+-*/"
- s1 (parse (>>= (none-of* op)
- (fn [a]
- (>>= (none-of* op)
- (fn [b]
- (>>= (none-of* op)
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "none-of* - three in a row until end of input"
- (:input s1) => empty?
- (:value s1) => (seq in))))
-
-
-(deftest test-0280
- (let [in "$foo"
- s1 (parse (none-of* "!@#$%^*()") in)]
- (fact "none-of* - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0280-05
- (let [in ""
- s1 (parse eof in)]
- (fact "eof - parses an empty string"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true)))
-
-
-(deftest test-0280-10
- (let [in "END."
- s1 (parse (>> (token* "END.") eof) in)]
- (fact "eof - verifies that input ends"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-15
- (let [in "END.// the end"
- s1 (parse (>> (token* "END.") eof) in)
- em (get-msg-str (:error s1))]
- (fact "eof - verifies that input ends"
- (:input s1) => (seq "// the end")
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected /\nexpecting end of input")))
-
-
-(deftest test-0280-20
- (let [in "12\n"
- s1 (parse (<*> digit digit new-line*) in)]
- (fact "new-line* - a new line after two digits"
- (:input s1) => empty?
- (:value s1) => [\1 \2 \newline]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-25
- (let [in "AB\r\nCD\r\n"
- s1 (parse (many1 (<< (many1 upper) new-line*)) in)]
- (fact "new-line* - pairs of letters separated by a new line"
- (:input s1) => empty?
- (:value s1) => [[\A \B] [\C \D]]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-30
- (let [in "12345 "
- s1 (parse (<< (many1 digit) new-line*) in)
- em (get-msg-str (:error s1))]
- (fact "new-line* - the line doesn't end with a new line"
- (:input s1) => [\space]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\space\nexpecting new line")))
-
-
-(deftest test-0280-35
- (let [in " \t \t \n \t *"
- s1 (parse (skip-ws (sym* \*)) in)]
- (fact "skip-ws - skips whitespaces before parsing a star"
- (:input s1) => empty?
- (:value s1) => \*
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-40
- (let [in "*"
- s1 (parse (skip-ws (sym* \*)) in)]
- (fact "skip-ws - nothing to skip before parsing a star"
- (:input s1) => empty?
- (:value s1) => \*
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-45
- (let [in "Now is the time... right... now."
- s1 (parse (field* "!") in)]
- (fact "field* - reads the whole string"
- (:input s1) => empty?
- (:value s1) => in
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-50
- (let [in "Now is the time; right... now."
- s1 (parse (field* ";") in)]
- (fact "field* - reads the field delimited by a semicolon"
- (:input s1) => (seq "; right... now.")
- (:value s1) => "Now is the time"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-55
- (let [in "Now-is-the-time"
- s1 (parse (split-on "-") in)]
- (fact "field - breaks the string into the words"
- (:value s1) => ["Now" "is" "the" "time"]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
- (deftest test-0280-60
- (let [in "Software,Tooling,495.95,0.00,,15,,xyz"
- s1 (parse (split-on ",") in)]
- (fact "field - breaks the string into fields; some are empty"
- (:value s1) => ["Software" "Tooling" "495.95" "0.00" "15" "xyz"]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-65
- (let [in "Now is the time. Or, is it? Yes! yes! that's it."
- s1 (parse (split-on " ,?!.") in)]
- (fact "field - collects all words; skips the given punctuation"
- (:value s1) => ["Now" "is" "the" "time" "Or" "is" "it" "Yes" "yes" "that's" "it"]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280-70
- (fact "mark parses a punctuation mark."
- (value mark "!") => \!
- (value mark "@") => \@
- (value mark "*") => \*
- (value mark ":") => \:
- (value mark "/") => \/
- (value mark ".") => \.))
-
-
-;; +-------------------------------------------------------------+
-;; | Parser combinators. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0285
- (let [s1 (parse letter "1")
- em (-> s1 :error :msgs first :text force)]
- (fact "first message in the msgs list"
- em => "letter")))
-
-
-(deftest test-0290
- (let [s1 (parse letter "1")
- em (get-msg-str (:error s1))]
- (fact "verify error messages"
- em => "unexpected \\1\nexpecting letter")))
-
-
-(deftest test-0295
- (let [s1 (parse ( (<*> digit letter) "digit,letter") "01")
- em (-> s1 :error :msgs first :text force)]
- (fact " - does not add message when input is consumed"
- em =not=> "digit,letter")))
-
-
-(deftest test-0300
- (let [s1 (parse ( (<*> digit letter) "digit,letter") "01")
- em (get-msg-str (:error s1))]
- (fact " - verifies error messages in <*>"
- em => "unexpected \\1\nexpecting letter")))
-
-
-(deftest test-0305
- (let [s1 (parse ( (<*> digit letter) "digit,letter") "0")
- em (get-msg-str (:error s1))]
- (fact " - verifies error messages in <*>"
- em => "unexpected end of input\nexpecting letter")))
-
-
-(deftest test-0310
- (let [s1 (parse (<|> digit letter) "*")
- em (get-msg-str (:error s1))]
- (fact "<|> - verifies error messages"
- em => "unexpected \\*\nexpecting digit or letter")))
-
-
-(deftest test-0315
- (let [s1 (parse (<|> (sym* \x) (<|> letter digit)) "*")
- em (get-msg-str (:error s1))]
- (fact "<|> - verifies error messages with 3 choices"
- em => "unexpected \\*\nexpecting \\x, letter or digit")))
-
-
-(deftest test-0320
- (let [s1 (parse (<|> (<|> white-space (sym* \x)) (<|> letter digit)) "*")
- em (get-msg-str (:error s1))]
- (fact "<|> - verifies error messages with 4 choices"
- em => "unexpected \\*\nexpecting whitespace, \\x, letter or digit")))
-
-
-(deftest test-0320-05
- (let [s1 (parse (expect (<+> letter digit) "number two") "U2")]
- (fact "expect - parser succeeds"
- (:value s1) => "U2"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0320-10
- (let [s1 (parse (expect (<+> letter digit) "number two") "UX")
- em (get-msg-str (:error s1))]
- (fact "expect - parser fails consuming input"
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\X\nexpecting number two")))
-
-
-(deftest test-0320-15
- (let [s1 (parse (expect (<+> letter digit) "number two") "007")
- em (get-msg-str (:error s1))]
- (fact "expect - parser fails without consuming any input"
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- (:input s1) => [\0 \0 \7]
- em => "unexpected \\0\nexpecting number two")))
-
-
-(deftest test-0325
- (let [s1 (parse (<|> letter digit) "U2")]
- (fact "<|> - the first parser succeeds"
- (:value s1) => \U
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\2]
- (:empty s1) => false)))
-
-
-(deftest test-0330
- (let [s1 (parse (<|> digit letter) "XYZ")]
- (fact "<|> - the second parser succeeds"
- (:value s1) => \X
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\Y \Z]
- (:empty s1) => false)))
-
-
-(deftest test-0335
- (let [s1 (parse (<|> (>> letter digit) letter) "XYZ")
- em (get-msg-str (:error s1))]
- (fact "<|> - the first parse fails consuming input"
- (:value s1) => nil
- (:ok s1) => false
- (:input s1) => [\Y \Z]
- (:empty s1) => false
- em => "unexpected \\Y\nexpecting digit")))
-
-
-(deftest test-0340
- (let [s1 (parse (<|> white-space letter digit) "*")
- em (get-msg-str (:error s1))]
- (fact "<|> - verifies error messages with 3 choices"
- em => "unexpected \\*\nexpecting whitespace, letter or digit")))
-
-
-(deftest test-0345
- (let [s1 (parse (<|> white-space (sym* \x) letter digit) "*")
- em (get-msg-str (:error s1))]
- (fact "<|> - verifies error messages with 4 choices"
- em => "unexpected \\*\nexpecting whitespace, \\x, letter or digit")))
-
-
-(deftest test-0350
- (let [s1 (parse (<|> white-space (sym* \x) letter digit) "\t")]
- (fact "<|> - the first of 4 parser succeeds"
- (:value s1) => \tab
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0355
- (let [s1 (parse (<|> white-space (sym* \x) letter digit) "x")]
- (fact "<|> - the second of 4 parser succeeds"
- (:value s1) => \x
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0360
- (let [s1 (parse (<|> white-space (sym* \x) letter digit) "z")]
- (fact "<|> - the third of 4 parser succeeds"
- (:value s1) => \z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0365
- (let [s1 (parse (<|> white-space (sym* \x) letter digit) "0")]
- (fact "<|> - the fourth parser succeeds"
- (:value s1) => \0
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0370
- (let [p1 (>>= letter (fn [x] (return (Character/toUpperCase x))))
- s1 (parse p1 "xyz")]
- (fact ">>= - advances one char"
- (:input s1) => [\y \z]
- (:value s1) => \X
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil
- (:pos s1) => (contains {:line 1 :col 2}))))
-
-
-(deftest test-0375
- (let [p1 (>>= digit
- (fn [x] (>>= digit
- (fn [y] (return (Integer/parseInt (str x y)))))))
- s1 (parse p1 "50113")]
- (fact ">>= - advances two chars"
- (:input s1) => [\1 \1 \3]
- (:value s1) => 50
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil
- (:pos s1) => (contains {:line 1 :col 3}))))
-
-
-(deftest test-0380
- (let [in "012345"
- p1 (>>= letter (fn [x] (return (int x))))
- s1 (parse p1 in)
- em (get-msg-str (:error s1))]
- (fact ">>= - the first parser fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- (:user s1) => nil
- (:pos s1) => (contains {:line 1 :col 1})
- em => "unexpected \\0\nexpecting letter")))
-
-
-(deftest test-0385
- (let [p1 (>>= letter (fn [_] digit))
- s1 (parse p1 "xyz")
- em (get-msg-str (:error s1))]
- (fact ">>= - the second parser fails"
- (:input s1) => [\y \z]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- (:user s1) => nil
- (:pos s1) => (contains {:line 1 :col 2})
- em => "unexpected \\y\nexpecting digit")))
-
-
-(deftest test-0385-05
- (let [p1 (bind [x letter] (return (Character/toUpperCase x)))
- s1 (parse p1 "xyz")]
- (fact "bind - advances one char"
- (:input s1) => [\y \z]
- (:value s1) => \X
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil
- (:pos s1) => (contains {:line 1 :col 2}))))
-
-
-(deftest test-0385-10
- (let [p1 (bind [x digit y digit]
- (return (Integer/parseInt (str x y))))
- s1 (parse p1 "50113")]
- (fact "bind - advances two chars"
- (:input s1) => [\1 \1 \3]
- (:value s1) => 50
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil
- (:pos s1) => (contains {:line 1 :col 3}))))
-
-
-(deftest test-0385-15
- (let [p1 (bind [_ (sym* \()
- s (<+> (many1 digit))
- _ (sym* \))]
- (return (* (Integer/parseInt s) -1)))
- s1 (parse p1 "(50113)")]
- (fact "bind - reads a negative number in parens, as in accounting"
- (:input s1) => empty?
- (:value s1) => -50113
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil)))
-
-
-(deftest test-0385-20
- (let [p1 (bind [x letter]
- (if (= x \x)
- (bind [y (sym* \Y)
- z (sym* \Z)] (return "first"))
- (bind [n (many1 digit)] (return 5005))))
- s1 (parse p1 "xYZ")]
- (fact "bind - uses nested bind inside the first function body"
- (:input s1) => empty?
- (:value s1) => "first"
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil)))
-
-
-(deftest test-0385-25
- (let [p1 (bind [x letter]
- (if (= x \x)
- (bind [y (sym* \Y)
- z (sym* \Z)] (return "first"))
- (bind [n (many1 digit)] (return 666))))
- s1 (parse p1 "A10002450")]
- (fact "bind - uses nested bind inside the first function body"
- (:input s1) => empty?
- (:value s1) => 666
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil)))
-
-
-(deftest test-0385-30
- (let [p1 (<|> (bind [x (many1 digit)] (return true))
- (bind [x (many1 letter)] (return false)))
- s1 (parse p1 "FALSE")]
- (fact "bind - the first bind fails, the second succeeds"
- (:input s1) => empty?
- (:value s1) => false
- (:ok s1) => true
- (:empty s1) => false
- (:user s1) => nil
- (:error s1) => nil)))
-
-
-(deftest test-0390
- (let [p1 (>> (sym* \+) digit)
- s1 (parse p1 "+1")]
- (fact ">> - consumes two chars, keeps the second"
- (:input s1) => empty?
- (:value s1) => \1
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0395
- (let [p1 (>> (sym* \+) digit)
- s1 (parse p1 "01")]
- (fact ">> - the first parser fails"
- (:input s1) => [\0 \1]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0400
- (let [p1 (>> (sym* \+) digit)
- s1 (parse p1 "+A")]
- (fact ">> - the second parser fails"
- (:input s1) => [\A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0405
- (let [p1 (>> digit digit letter)
- s1 (parse p1 "01A")]
- (fact ">> - consumes three chars, keeps the last"
- (:input s1) => empty?
- (:value s1) => \A
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0410
- (let [p1 (>> digit digit digit letter)
- s1 (parse p1 "012A")]
- (fact ">> - consumes four chars, keeps the last"
- (:input s1) => empty?
- (:value s1) => \A
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0415
- (let [p1 (>> digit digit digit letter)
- s1 (parse p1 "A")]
- (fact ">> - the first fails"
- (:input s1) => [\A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0420
- (let [p1 (>> digit digit digit letter)
- s1 (parse p1 "01A")]
- (fact ">> - the third fails"
- (:input s1) => [\A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0425
- (let [p1 (<< letter (sym* \;))
- s1 (parse p1 "a;")]
- (fact "<< - consumes two chars, keeps the first"
- (:input s1) => empty?
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0430
- (let [p1 (<< letter (sym* \;))
- s1 (parse p1 "0;")]
- (fact "<< - the first parser fails"
- (:input s1) => [\0 \;]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0435
- (let [p1 (<< letter (sym* \;))
- s1 (parse p1 "A*")]
- (fact "<< - the second parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0440
- (let [p1 (<< any-char digit digit)
- s1 (parse p1 "+01")]
- (fact "<< - consumes three chars, keeps the first"
- (:input s1) => empty?
- (:value s1) => \+
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0445
- (let [p1 (<< any-char digit digit digit digit)
- s1 (parse p1 "+0123")]
- (fact "<< - consumes five chars, keeps the first"
- (:input s1) => empty?
- (:value s1) => \+
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0450
- (let [p1 (<< any-char digit digit digit digit)
- s1 (parse p1 "+01*")]
- (fact "<< - the fourth parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0455
- (let [s1 (parse (<$> count (many any-char)) "abcdef+01234*")]
- (fact "<$> - counts the length of the input"
- (:input s1) => empty?
- (:value s1) => 13
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0460
- (let [s1 (parse (<$> #(- (int %) (int \0)) digit) "9")]
- (fact "<$> - converts a char digit into an int"
- (:input s1) => empty?
- (:value s1) => 9
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0465
- (let [s1 (parse (<$> #(- (int %) (int \0)) digit) "A")]
- (fact "<$> - fails and the function is not applied"
- (:input s1) => [\A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0469-a
- (let [s1 (parse (<*> digit) "9")]
- (fact "<*> - collects from one parser"
- (:input s1) => empty?
- (:value s1) => [\9]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0469-b
- (let [s1 (parse (<*> letter) "U2")]
- (fact "<*> - collects from one parser"
- (:input s1) => [\2]
- (:value s1) => [\U]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0470
- (let [s1 (parse (<*> (sym* \-) digit) "-1")]
- (fact "<*> - collects from two parsers"
- (:input s1) => empty?
- (:value s1) => [\- \1]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0475
- (let [s1 (parse (<*> (sym* \-) digit (sym* \;)) "-1;")]
- (fact "<*> - collects from three parsers"
- (:input s1) => empty?
- (:value s1) => [\- \1 \;]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0480
- (let [p1 (<*> letter (>> (sym* \|) letter) (>> (sym* \|) digit))
- s1 (parse p1 "X|Y|9")]
- (fact "<*> - collects from filtering parsers"
- (:input s1) => empty?
- (:value s1) => [\X \Y \9]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0485
- (let [in "ABC012"
- p1 (<*> (<*> letter letter letter) (<*> digit digit digit))
- s1 (parse p1 in)]
- (fact "<*> - collects from compound parsers"
- (:input s1) => empty?
- (:value s1) => '((\A \B \C) (\0 \1 \2))
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0485-05
- (let [s1 (parse (<*> letter digit) "u2")]
- (fact "<*> - collects results in a vector"
- (:input s1) => empty?
- (:value s1) => vector?
- (:value s1) => [\u \2]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0490
- (let [s1 (parse (<*> letter digit) "*")]
- (fact "<*> - the first parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0495
- (let [s1 (parse (<*> letter digit) "A*")]
- (fact "<*> - the second parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0500
- (let [s1 (parse (<*> letter tab digit) "A\t*")]
- (fact "<*> - the third parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0505
- (let [p1 (<*> letter tab tab tab tab tab (sym* \x))
- s1 (parse p1 "A\t\t\t\t\t*")]
- (fact "<*> - the seventh parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-0510
- (let [s1 (parse (<:> lower) "a")]
- (fact "<:> - parses an item; consumes all input"
- (:input s1) => empty?
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0515
- (let [s1 (parse (<:> (<$> (partial apply str) (<*> (token* "end") space))) "end ")]
- (fact "<:> - parses nested items; consumes all input"
- (:input s1) => empty?
- (:value s1) => "end "
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0520
- (let [in "a1b3c4d5e7f8"
- p1 (<*> letter digit)
- s1 (parse (<:> (many p1)) in)]
- (fact "<:> - parses six pairs; consumes all input"
- (:input s1) => empty?
- (:value s1) => '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8))
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0525
- (let [s1 (parse (<:> lower) "*&!")]
- (fact "<:> - fails with parsers consuming no input; consumes no input"
- (:input s1) => [\* \& \!]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-0530
- (let [s1 (parse (<:> (<*> upper lower upper)) "Mi*")
- em (get-msg-str (:error s1))]
- (fact "<:> - fails with parsers consuming input; consumes no input"
- (:input s1) => [\M \i \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting uppercase letter")))
-
-
-(deftest test-0535
- (let [s1 (parse (<|> (<:> (>> digit letter)) digit) "1*")
- em (get-msg-str (:error s1))]
- (fact "<:> - verifies that it allows <|> to test the next choice"
- (:input s1) => [\*]
- (:value s1) => \1
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0540
- (let [s1 (parse (<|> (<:> letter) digit) "***")
- em (get-msg-str (:error s1))]
- (fact "<:> - verifies that it carries over the error msg"
- (:input s1) => [\* \* \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting letter or digit")))
-
-
-(deftest test-0545
- (let [s1 (parse (many lower) "*")]
- (fact "many - parses zero items"
- (:input s1) => [\*]
- (:value s1) => empty?
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0550
- (let [s1 (parse (many lower) "a*")]
- (fact "many - parses one item"
- (:input s1) => [\*]
- (:value s1) => [\a]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0555
- (let [s1 (parse (many (optional letter)) "ABCDEGFHIJK*")]
- (fact "many - skips optional items; consumes input though value is empty"
- (:input s1) => [\*]
- (:value s1) => (seq "ABCDEGFHIJK")
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0560
- (let [in "a1b3c4d5e7f8"
- p1 (<*> letter digit)
- s1 (parse (many p1) in)]
- (fact "many - parses six compound items"
- (:input s1) => empty?
- (:value s1) => '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0560-05
- (let [s1 (parse (many lower) "*")]
- (fact "many - collects the result in a vector; parses zero items"
- (:input s1) => [\*]
- (:value s1) => empty?
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0560-10
- (let [s1 (parse (many lower) "a*")]
- (fact "many - collects the result in a vector; parses one item"
- (:input s1) => [\*]
- (:value s1) => [\a]
-
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0565
- (let [s1 (parse (<|> (many lower) (sym* \*)) "*")]
- (fact "many - consumes no input and succeeds; <|> returns its value"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0570
- (let [in "a1b3c4d5ee"
- p1 (<*> letter digit)
- s1 (parse (many p1) in)
- em (get-msg-str (:error s1))]
- (fact "many - parses four compound items, then fails in the next compound item"
- (:input s1) => [\e]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\e\nexpecting digit")))
-
-
-(deftest test-0575
- (let [s1 (parse (many1 lower) "*")
- em (get-msg-str (:error s1))]
- (fact "many1 - fails with zero items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting lowercase letter")))
-
-
-(deftest test-0580
- (let [s1 (parse (many1 lower) "a*")]
- (fact "many1 - parses one item"
- (:input s1) => [\*]
- (:value s1) => [\a]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0580-05
- (let [s1 (parse (many1 lower) "a*")]
- (fact "many1 - collects the result in a vector; parses one item"
- (:input s1) => [\*]
- (:value s1) => [\a]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0585
- (let [in "a1b3c4d5e7f8"
- p1 (<*> letter digit)
- s1 (parse (many1 p1) in)]
- (fact "many1 - parses six compound items"
- (:input s1) => empty?
- (:value s1) => '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0590
- (let [s1 (parse (<|> (many1 lower) (sym* \*)) "w*")]
- (fact "many1 - consumes input; <|> returns its value"
- (:input s1) => [\*]
- (:value s1) => [\w]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0595
- (let [s1 (parse (<|> (many1 digit) upper) "*")
- em (get-msg-str (:error s1))]
- (fact "many1 - fails; passes on empty, errors to <|>"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit or uppercase letter")))
-
-
-(deftest test-0600
- (let [s1 (parse (<|> (many1 digit) upper) "A")]
- (fact "many1 - fails; passes on empty, are cleared in <|>"
- (:input s1) => empty?
- (:value s1) => \A
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0605
- (let [in "a1b3c4d5ee"
- p1 (<*> letter digit)
- s1 (parse (many1 p1) in)
- em (get-msg-str (:error s1))]
- (fact "many1 - parses four compound items, then fails in the next compound item"
- (:input s1) => [\e]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\e\nexpecting digit")))
-
-
-(deftest test-0610
- (let [s1 (parse (optional (<*> upper digit)) "U2*")]
- (fact "optional - parses an optional item"
- (:input s1) => [\*]
- (:value s1) => [\U \2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0615
- (let [s1 (parse (optional (<*> upper digit)) "u2*")]
- (fact "optional - fails consuming no input"
- (:input s1) => [\u \2 \*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0620
- (let [s1 (parse (optional (<*> upper digit)) "UP*")
- em (get-msg-str (:error s1))]
- (fact "optional - fails consuming input"
- (:input s1) => [\P \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\P\nexpecting digit")))
-
-
-(deftest test-0625
- (let [p1 (<$> (partial apply str) (<*> (optional upper) (sym* \*)))
- s1 (parse p1 "U*")]
- (fact "optional - skips the optional char"
- (:input s1) => empty?
- (:value s1) => "U*"
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0630
- (let [s1 (parse (option "XY" (<*> upper digit)) "U2*")]
- (fact "option - parses an item"
- (:input s1) => [\*]
- (:value s1) => [\U \2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0635
- (let [s1 (parse (option "XY" (<*> upper digit)) "u2*")]
- (fact "option - fails without consuming input; produces optional value"
- (:input s1) => [\u \2 \*]
- (:value s1) => "XY"
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0640
- (let [s1 (parse (option "XY" (<*> upper digit)) "UP*")
- em (get-msg-str (:error s1))]
- (fact "option - fails consuming input"
- (:input s1) => [\P \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\P\nexpecting digit")))
-
-
-(deftest test-0640-05
- (let [s1 (parse (skip (sym* \*)) "*")]
- (fact "skip - skips a star"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0640-10
- (let [s1 (parse (skip letter digit) "U2")]
- (fact "skip - skips a letter and a digit"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0640-15
- (let [s1 (parse (skip (sym* \*) letter digit (sym* \*)) "*U2*")]
- (fact "skip - skips a star, a letter, a digit, and a star"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0645
- (let [s1 (parse (skip-many letter) "*")]
- (fact "skip-many - skips zero letters"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0650
- (let [s1 (parse (skip-many (<*> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "skip-many - skips zero compound items; <*> fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0655
- (let [s1 (parse (skip-many (<*> digit lower)) "0x*")]
- (fact "skip-many - skips one compound item"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0660
- (let [s1 (parse (skip-many letter) "abcdefghijk*")]
- (fact "skip-many - skips letters"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0665
- (let [s1 (parse (skip-many (<*> digit lower)) "0x1y2z*")]
- (fact "skip-many - skips three compound items; consumes no more input"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0670
- (let [s1 (parse (>> (skip-many (optional digit)) (sym* \*)) "0123456789*")]
- (fact "skip-many - skips optional items; then consumes more input"
- (:input s1) => empty?
- (:value s1) => \*
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0675
- (let [s1 (parse (skip-many1 letter) "*")
- em (get-msg-str (:error s1))]
- (fact "skip-many1 - fails with zero letters"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting letter")))
-
-
-(deftest test-0680
- (let [s1 (parse (skip-many1 (<*> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "skip-many1 - skips zero compound items; <*> fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0685
- (let [s1 (parse (skip-many1 (<*> digit lower)) "0x*")]
- (fact "skip-many1 - skips one compound item"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0690
- (let [s1 (parse (skip-many1 letter) "abcdefghijk*")]
- (fact "skip-many1 - skips letters"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0695
- (let [s1 (parse (skip-many1 (<*> digit lower)) "0x1y2z*")]
- (fact "skip-many1 - skips three compound items; consumes no more input"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0700
- (let [s1 (parse (>> (skip-many1 (optional digit)) (sym* \*)) "0123456789*")]
- (fact "skip-many1 - skips optional items; then consumes more input"
- (:input s1) => empty?
- (:value s1) => \*
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0705
- (let [s1 (parse (sep-by (sym* \,) digit) "*")]
- (fact "sep-by - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0710
- (let [s1 (parse (sep-by (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "sep-by - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0715
- (let [s1 (parse (sep-by (sym* \,) digit) "0*")]
- (fact "sep-by - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0720
- (let [s1 (parse (sep-by (sym* \,) (<*> upper digit)) "U2*")]
- (fact "sep-by - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0725
- (let [s1 (parse (sep-by (sym* \,) (>> letter digit)) "U2,*")
- em (get-msg-str (:error s1))]
- (fact "sep-by - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter")))
-
-
-(deftest test-0730
- (let [s1 (parse (sep-by (sym* \,) digit) "0,1*")]
- (fact "sep-by - two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0730-05
- (let [s1 (parse (sep-by (sym* \,) digit) "0,1*")]
- (fact "sep-by - collects the result in a vector; two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0735
- (let [s1 (parse (sep-by (sym* \,) (>> (sym* \+) digit)) "+0,+1*")]
- (fact "sep-by - two compound items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0740
- (let [p1 (sep-by (many white-space) (many letter))
- s1 (parse p1 "one two \t\t three")]
- (fact "sep-by - three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "three"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0745
- (let [s1 (parse (sep-by1 (sym* \,) digit) "*")
- em (get-msg-str (:error s1))]
- (fact "sep-by1 - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0750
- (let [s1 (parse (sep-by1 (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "sep-by1 - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0755
- (let [s1 (parse (sep-by1 (sym* \,) digit) "0*")]
- (fact "sep-by1 - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0760
- (let [s1 (parse (sep-by1 (sym* \,) (<*> upper digit)) "U2*")]
- (fact "sep-by1 - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0765
- (let [s1 (parse (sep-by1 (sym* \,) (>> letter digit)) "U2,*")
- em (get-msg-str (:error s1))]
- (fact "sep-by1 - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter")))
-
-
-(deftest test-0770
- (let [s1 (parse (sep-by1 (sym* \,) digit) "0,1*")]
- (fact "sep-by1 - two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0770-05
- (let [s1 (parse (sep-by1 (sym* \,) digit) "0,1*")]
- (fact "sep-by1 - collects the result in a vector; two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0775
- (let [s1 (parse (sep-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1*")]
- (fact "sep-by1 - two compound items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0780
- (let [p1 (sep-by1 (many white-space) (many letter))
- s1 (parse p1 "one two \t\t three")]
- (fact "sep-by1 - three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "three"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0785
- (let [s1 (parse (sep-by1 (sym* \|) (>> upper digit)) "A1|B2|C3|DD,*")
- em (get-msg-str (:error s1))]
- (fact "sep-by1 - compound item fails after reading several items"
- (:input s1) => [\D \, \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\D\nexpecting digit")))
-
-
-(deftest test-0790
- (let [s1 (parse (end-by (sym* \,) digit) "*")]
- (fact "end-by - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0800
- (let [s1 (parse (end-by (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "end-by - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0805
- (let [s1 (parse (end-by (sym* \,) digit) "0*")
- em (get-msg-str (:error s1))]
- (fact "end-by - one item; with no separator it fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting \\,")))
-
-
-(deftest test-0810
- (let [s1 (parse (end-by (sym* \,) (<*> upper digit)) "U2*")
- em (get-msg-str (:error s1))]
- (fact "end-by - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting \\,")))
-
-
-(deftest test-0815
- (let [s1 (parse (end-by (sym* \,) (>> letter digit)) "U2,*")]
- (fact "end-by - there is one item that ends with a separator"
- (:input s1) => [\*]
- (:value s1) => [\2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0820
- (let [s1 (parse (end-by (sym* \,) digit) "0,1,*")]
- (fact "end-by - two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0820-05
- (let [s1 (parse (end-by (sym* \,) digit) "0,1,*")]
- (fact "end-by - collects the result in a vector; two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0825
- (let [s1 (parse (end-by (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
- (fact "end-by - two compound items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0830
- (let [p1 (end-by (many white-space) (many letter))
- s1 (parse p1 "one two \t\t three\n")]
- (fact "end-by - three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "three"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0835
- (let [s1 (parse (end-by1 (sym* \,) digit) "*")
- em (get-msg-str (:error s1))]
- (fact "end-by1 - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0840
- (let [s1 (parse (end-by1 (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "end-by1 - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0845
- (let [s1 (parse (end-by1 (sym* \,) digit) "0*")
- em (get-msg-str (:error s1))]
- (fact "end-by1 - one item; with no separator it fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting \\,")))
-
-
-(deftest test-0850
- (let [s1 (parse (end-by1 (sym* \,) (<*> upper digit)) "U2*")
- em (get-msg-str (:error s1))]
- (fact "end-by1 - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting \\,")))
-
-
-(deftest test-0855
- (let [s1 (parse (end-by1 (sym* \,) (>> letter digit)) "U2,*")]
- (fact "end-by1 - there is one item and the separator"
- (:input s1) => [\*]
- (:value s1) => [\2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0860
- (let [s1 (parse (end-by1 (sym* \,) digit) "0,1,*")]
- (fact "end-by1 - two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0860-05
- (let [s1 (parse (end-by1 (sym* \,) digit) "0,1,*")]
- (fact "end-by1 - collects the result in a vector; two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0865
- (let [s1 (parse (end-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
- (fact "end-by1 - two compound items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0870
- (let [p1 (end-by1 (many white-space) (many letter))
- s1 (parse p1 "one two \t\t three\n")]
- (fact "end-by1 - three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "three"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0880
- (let [s1 (parse (end-by1 (sym* \|) (>> upper digit)) "A1|B2|C3|DD,*")
- em (get-msg-str (:error s1))]
- (fact "end-by1 - compound item fails after reading several items"
- (:input s1) => [\D \, \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\D\nexpecting digit")))
-
-
-(deftest test-0885
- (let [s1 (parse (sep-end-by (sym* \,) digit) "*")]
- (fact "sep-end-by - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0890
- (let [s1 (parse (sep-end-by (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "sep-end-by - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0895
- (let [s1 (parse (sep-end-by (sym* \,) digit) "0*")]
- (fact "sep-end-by - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0900
- (let [s1 (parse (sep-by (sym* \,) (<*> upper digit)) "U2*")]
- (fact "sep-by - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0905
- (let [s1 (parse (sep-end-by (sym* \,) (>> letter digit)) "U2,*")]
- (fact "sep-end-by - one item ended by the separator"
- (:input s1) => [\*]
- (:value s1) => [\2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0910
- (let [s1 (parse (sep-end-by (sym* \,) digit) "0,1*")]
- (fact "sep-end-by - two simple items separated by ,"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0910-05
- (let [s1 (parse (sep-end-by (sym* \,) digit) "0,1*")]
- (fact "sep-end-by - collects the result in a vector; two simple items separated by ,"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-(deftest test-0915
- (let [s1 (parse (sep-end-by (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
- (fact "sep-end-by - two compound items separated and ended by ,"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0920
- (let [p1 (sep-end-by (many1 white-space) (<*> letter letter letter))
- s1 (parse p1 "one two\t \tsix\n")]
- (fact "sep-end-by - three compound items; using many1 to avoid an SO"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "six"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0925
- (let [s1 (parse (sep-end-by1 (sym* \,) digit) "*")
- em (get-msg-str (:error s1))]
- (fact "sep-end-by1 - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0930
- (let [s1 (parse (sep-end-by1 (sym* \,) (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "sep-end-by1 - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0935
- (let [s1 (parse (sep-end-by1 (sym* \,) digit) "0*")]
- (fact "sep-end-by1 - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0940
- (let [s1 (parse (sep-end-by1 (sym* \,) (<*> upper digit)) "U2*")]
- (fact "sep-end-by1 - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0950
- (let [s1 (parse (sep-end-by1 (sym* \,) (>> letter digit)) "U2,*")]
- (fact "sep-end-by1 - one compound item ended by the separator"
- (:input s1) => [\*]
- (:value s1) => [\2]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0960
- (let [s1 (parse (sep-end-by1 (sym* \,) digit) "0,1*")]
- (fact "sep-end-by1 - two simple items"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0965
- (let [s1 (parse (sep-end-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
- (fact "sep-end-by1 - two compound items ended by the separator"
- (:input s1) => [\*]
- (:value s1) => [\0 \1]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0970
- (let [p1 (sep-end-by1 white-space (<*> letter letter letter))
- s1 (parse p1 "one two\tsix\n")]
- (fact "sep-end-by1 - three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "six"))
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0970-05
- (let [p1 (sep-end-by1 white-space (<*> letter letter letter))
- s1 (parse p1 "one two\tsix\n")]
- (fact "sep-end-by1 - collects the result in a vector; three compound items"
- (:input s1) => empty?
- (:value s1) => (list (seq "one") (seq "two") (seq "six"))
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0970-10
- (let [p1 (sep-end-by1 white-space (many1 letter))
- s1 (parse p1 "one")]
- (fact "sep-end-by1 - collects the result in a vector; one compound item"
- (:input s1) => empty?
- (:value s1) => [(seq "one")]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0975
- (let [s1 (parse (sep-end-by1 (sym* \|) (>> upper digit)) "A1|B2|C3|DD,*")
- em (get-msg-str (:error s1))]
- (fact "sep-end-by1 - compound item fails after reading several items"
- (:input s1) => [\D \, \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\D\nexpecting digit")))
-
-
-(deftest test-0980
- (let [s1 (parse (between (sym* \{) (sym* \}) digit) "{0}*")]
- (fact "between - one item"
- (:input s1) => [\*]
- (:value s1) => \0
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0980-05
- (let [s1 (parse (between (sym* \:) digit) ":0:*")]
- (fact "between - with same delimiter - one item"
- (:input s1) => [\*]
- (:value s1) => \0
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0980-10
- (let [s1 (parse (between (sym* \|) (many digit)) "|5005|*")]
- (fact "between - with same delimiter - multiple items"
- (:input s1) => [\*]
- (:value s1) => [\5 \0 \0 \5]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0985
- (let [p1 (>>= letter
- (fn [x] (>>= (many alpha-num)
- (fn [y] (return (cons x y))))))
- s1 (parse (between (sym* \{) (sym* \}) p1) "{abc101z}*")]
- (fact "between - one compound item"
- (:input s1) => [\*]
- (:value s1) => (seq "abc101z")
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0990
- (let [s1 (parse (between (sym* \{) (sym* \}) digit) "(0}*")
- em (get-msg-str (:error s1))]
- (fact "between - the open parser fails"
- (:input s1) => [\( \0 \} \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\(\nexpecting \\{")))
-
-
-(deftest test-0995
- (let [s1 (parse (between (sym* \{) (sym* \}) digit) "{0)*")
- em (get-msg-str (:error s1))]
- (fact "between - the close parser fails"
- (:input s1) => [\) \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\)\nexpecting \\}")))
-
-
-(deftest test-1000
- (let [s1 (parse (times 0 digit) "0*")]
- (fact "times - zero items"
- (:input s1) => [\0 \*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1001
- (let [s1 (parse (times 1 letter) "x")]
- (fact "times - one item"
- (:input s1) => []
- (:value s1) => [\x]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1005
- (let [s1 (parse (times 3 (>> any-char letter)) "*a@b$c")]
- (fact "times - three items"
- (:input s1) => empty?
- (:value s1) => [\a \b \c]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1005-05
- (let [s1 (parse (times 3 (>> any-char letter)) "*a@b$c")]
- (fact "times - collects the result in a vector; three items"
- (:input s1) => empty?
- (:value s1) => [\a \b \c]
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1010
- (let [s1 (parse (times 3 (>> any-char letter)) "*a@b$$")
- em (get-msg-str (:error s1))]
- (fact "times - two items, then fails"
- (:input s1) => [\$]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\$\nexpecting letter")))
-
-
-(deftest test-1015
- (let [s1 (parse (<$> count (look-ahead (many digit))) "12345678")]
- (fact "look-ahead - succeeds consuming input"
- (:input s1) => (seq "12345678")
- (:value s1) => 8
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1020
- (let [s1 (parse (look-ahead (many digit)) "YYZ")]
- (fact "look-ahead - succeeds consuming no input"
- (:input s1) => [\Y \Y \Z]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1025
- (let [s1 (parse (look-ahead digit) "*")]
- (fact "look-ahead - fails consuming no input"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1030
- (let [s1 (parse (look-ahead (>> letter digit)) "A*")]
- (fact "look-ahead - fails consuming no input"
- (:input s1) => [\A \*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1030-05
- (let [s1 (parse (predict (sym* \=)) "=10")]
- (fact "predict - if p succeeds it consumes no input"
- (:input s1) => [\= \1 \0]
- (:value s1) => \=
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1030-10
- (let [s1 (parse (predict (sym* \=)) "<10")]
- (fact "predict - if p succeeds it consumes no input"
- (:input s1) => [\< \1 \0]
- (:value s1) => nil?
- (:ok s1) => false?
- (:empty s1) => true?)))
-
-
-(deftest test-1035
- (let [s1 (parse (not-followed-by digit) "**")]
- (fact "not-followed-by - succeeds as digit fails"
- (:input s1) => [\* \*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1040
- (let [s1 (parse (not-followed-by (>> letter letter digit)) "xy**")]
- (fact "not-followed-by - succeeds as compound item fails"
- (:input s1) => [\x \y \* \*]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1045
- (let [s1 (parse (not-followed-by (<*> upper digit)) "U2*")
- em (get-msg-str (:error s1))]
- (fact "not-followed-by - fails as the parse succeeds"
- (:input s1) => [\U \2 \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected [\\U \\2]")))
-
-
-(deftest test-1050
- (let [s1 (parse (>> upper upper upper eof) "YYZ")]
- (fact "eof - there's nothing left"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1055
- (let [s1 (parse eof "")]
- (fact "eof - there's nothing to begin with"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-1060
- (let [s1 (parse (<*> upper digit eof) "U2*")
- em (get-msg-str (:error s1))]
- (fact "eof - fails because the input isn't empty"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected *\nexpecting end of input")))
-
-
-(deftest test-1065
- (let [s1 (parse (many-till digit letter) "123456A")]
- (fact "many-till - parses several numbers, then a letter"
- (:input s1) => empty?
- (:value s1) => (seq "123456")
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1065-05
- (let [s1 (parse (many-till digit letter) "123456A")]
- (fact "many-till - collects the result in a vector; several numbers and a letter"
- (:input s1) => empty?
- (:value s1) => (seq "123456")
- (:value s1) => vector?
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1070
- (let [s1 (parse (many-till digit letter) "A*")]
- (fact "many-till - just the end parser"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1075
- (let [p1 (>> (token* ""))))
- s1 (parse p1 "")]
- (fact "many-till - reads a space between xml comments"
- (:input s1) => empty?
- (:value s1) => [\space]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1080
- (let [p1 (>> (token* ""))))
- s1 (parse p1 "")]
- (fact "many-till - reads a word between xml comments"
- (:input s1) => empty?
- (:value s1) => (seq "foobar")
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-1085
- (let [s1 (parse (many-till digit letter) "*A")
- em (get-msg-str (:error s1))]
- (fact "many-till - fails parsing the prefix"
- (:input s1) => [\* \A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting letter or digit")))
-
-
-(deftest test-1090
- (let [s1 (parse (many-till digit letter) "12345*A")
- em (get-msg-str (:error s1))]
- (fact "many-till - parses several prefixes and then fails"
- (:input s1) => [\* \A]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter or digit")))
-
-
-(deftest test-1095
- (let [s1 (parse (many-till digit (>> upper (sym* \X))) "12345A*")
- em (get-msg-str (:error s1))]
- (fact "many-till - parses the prefix, then fails reading the end parser"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting \\X")))
-
-
-(deftest test-1113
- (let [s1 (parse (<+> letter) "a")]
- (fact "<+> - cats from one parser"
- (:input s1) => empty?
- (:value s1) => "a"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1114
- (let [s1 (parse (<+> (times 3 (sym* \S))) "SSS")]
- (fact "<+> - cats from one parser"
- (:input s1) => empty?
- (:value s1) => "SSS"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1115
- (let [s1 (parse (<+> (sym* \-) digit) "-1")]
- (fact "<+> - cats from two parsers"
- (:input s1) => empty?
- (:value s1) => "-1"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1120
- (let [s1 (parse (<+> (sym* \-) digit (sym* \;)) "-1;")]
- (fact "<+> - cats from three parsers"
- (:input s1) => empty?
- (:value s1) => "-1;"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1125
- (let [p1 (<+> letter (>> (sym* \|) letter) (>> (sym* \|) digit))
- s1 (parse p1 "X|Y|9")]
- (fact "<+> - cats from filtering parsers"
- (:input s1) => empty?
- (:value s1) => "XY9"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1130
- (let [in "ABC012"
- p1 (<+> (<*> letter letter letter) (<*> digit digit digit))
- s1 (parse p1 in)]
- (fact "<+> - cats from compound parsers"
- (:input s1) => empty?
- (:value s1) => "ABC012"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1135
- (let [s1 (parse (<+> letter digit) "*")]
- (fact "<+> - the first parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true)))
-
-
-(deftest test-1140
- (let [s1 (parse (<+> letter digit) "A*")]
- (fact "<+> - the second parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-1145
- (let [s1 (parse (<+> letter tab digit) "A\t*")]
- (fact "<+> - the third parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-1150
- (let [p1 (<+> letter tab tab tab tab tab (sym* \x))
- s1 (parse p1 "A\t\t\t\t\t*")]
- (fact "<+> - the seventh parser fails"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false)))
-
-
-(deftest test-1150-05
- (let [s1 (parse (search dec-num) "Now I have 20 dollars")]
- (fact "search - a simple number"
- (:input s1) => (seq " dollars")
- (:value s1) => 20
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1150-10
- (let [s1 (parse (many (search dec-num)) "Now I have 20 dollars, or 2 tens")]
- (fact "search - multiple numbers"
- (:input s1) => empty?
- (:value s1) => [20 2]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1150-15
- (let [s1 (parse (many (search (<|> dec-num (token* "dollars")))) "Now I have 20 dollars")]
- (fact "search - multiple choices, multiple times"
- (:input s1) => empty?
- (:value s1) => [20 "dollars"]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-;; +-------------------------------------------------------------+
-;; | Parser state. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-1155
- (let [p1 (>> (put-state 0)
- (skip-many
- (bind [x any-char]
- (if (= x \newline) (modify-state inc) (return nil)))))
- s1 (parse p1 "aaa\nbbb\nccc\nddd\nfff\nggg\nhhh\n\niii\njjj\n\nkkk")]
- (fact "put-state, modify-state"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:user s1) => 11
- (:empty s1) => false)))
-
-
-(deftest test-1160
- (let [p1 (>> (skip (put-state 0)
- (skip-many
- (bind [x any-char]
- (if (= x \newline) (modify-state inc) (return nil)))))
- get-state)
- s1 (parse p1 "aaa\nbbb\nccc\nddd\nfff\nggg\nhhh\n\niii\njjj\n\nkkk")]
- (fact "put-state, get-state; get user state as the parser's value"
- (:input s1) => empty?
- (:value s1) => 11
- (:ok s1) => true
- (:user s1) => 11
- (:empty s1) => false)))
-
-
-(deftest test-1165
- (let [in "ABC"
- p1 (<+> letter letter letter)
- p2 (>> (set-input "XYZ") p1)
- s1 (parse (<*> p1 p2) in)]
- (fact "set-input"
- (:input s1) => empty?
- (:value s1) => ["ABC" "XYZ"]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1170
- (let [in "ABC"
- p1 (<+> letter letter letter)
- p2 (>> (skip (set-input "XY0")
- (set-position (make-pos "include"))) p1)
- s1 (parse (<*> p1 p2) in)
- em (get-msg-str (:error s1))
- ip (:pos s1)]
- (fact "set-input, set-position"
- (:input s1) => [\0]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- (:src ip) => "include"
- (:line ip) => 1
- (:col ip) => 3
- em => "unexpected \\0\nexpecting letter")))
-
-
-(deftest test-1175
- (let [in "ABC"
- p1 (<+> letter letter letter)
- p2 (>> (skip (set-input "WXYZ")
- (set-position (make-pos "include"))) get-position)
- s1 (parse (>> p1 p2) in)
- v1 (:value s1)]
- (fact "set-input, set-position, get-position"
- (:input s1) => (seq "WXYZ")
- (:src v1) => "include"
- (:line v1) => 1
- (:col v1) => 1
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1180
- (let [in "ABC"
- p1 (<+> letter letter letter)
- p2 (>> (set-input "XYZ") get-input)
- s1 (parse (>> p1 p2) in)]
- (fact "set-input, get-input"
- (:input s1) => [\X \Y \Z]
- (:value s1) => [\X \Y \Z]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-;; +-------------------------------------------------------------+
-;; | Numeric parsers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-1185
- (let [s1 (parse dec-num "747")]
- (fact "dec-num - reads a simple integer"
- (:input s1) => empty?
- (:value s1) => 747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1190
- (let [s1 (parse dec-num "747-600")]
- (fact "dec-num - reads a simple integer, delimited"
- (:input s1) => [\- \6 \0 \0]
- (:value s1) => 747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1195
- (let [s1 (parse (>> upper dec-num) "A380aircraft")]
- (fact "dec-num - reads an integer, delimited"
- (:input s1) => (seq "aircraft")
- (:value s1) => 380
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1200
- (let [s1 (parse dec-num "987654321987654321000|")]
- (fact "dec-num - reads an integer, delimited"
- (:input s1) => [\|]
- (:value s1) => 987654321987654321000N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1205
- (let [s1 (parse oct-num "0747")]
- (fact "oct-num - reads a simple octal number"
- (:input s1) => empty?
- (:value s1) => 0747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1210
- (let [s1 (parse oct-num "0747-600")]
- (fact "oct-num - reads a simple octal number, delimited"
- (:input s1) => [\- \6 \0 \0]
- (:value s1) => 0747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1215
- (let [s1 (parse (>> upper oct-num) "B767aircraft")]
- (fact "oct-num - reads an octal number, delimited"
- (:input s1) => (seq "aircraft")
- (:value s1) => 0767
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1220
- (let [s1 (parse oct-num "76543217654321000000|")]
- (fact "oct-num - reads an octal number, delimited"
- (:input s1) => [\|]
- (:value s1) => 076543217654321000000N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1225
- (let [s1 (parse hex-num "747")]
- (fact "hex-num - reads a simple hex number"
- (:input s1) => empty?
- (:value s1) => 0x747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1230
- (let [s1 (parse hex-num "747-600")]
- (fact "hex-num - reads a simple hex number, delimited"
- (:input s1) => [\- \6 \0 \0]
- (:value s1) => 0x747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1235
- (let [s1 (parse (>> upper hex-num) "A380plane")]
- (fact "hex-num - reads a hex number, delimited"
- (:input s1) => (seq "plane")
- (:value s1) => 0x380
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1240
- (let [s1 (parse hex-num "ABCDEF987654321987654321000|")]
- (fact "hex-num - reads a hex number, delimited"
- (:input s1) => [\|]
- (:value s1) => 0xABCDEF987654321987654321000N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1245
- (let [s1 (parse float-num "100")]
- (fact "float-num - reads a simple floating-point number"
- (:input s1) => empty?
- (:value s1) => 100.0
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1250
- (let [s1 (parse float-num "3.1415927")]
- (fact "float-num - reads a simple floating-point number"
- (:input s1) => empty?
- (:value s1) => 3.1415927
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1255
- (let [s1 (parse float-num "9.8m/s")]
- (fact "float-num - reads a simple floating-point number, delimited"
- (:input s1) => [\m \/ \s]
- (:value s1) => 9.8
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1260
- (let [s1 (parse float-num "0.00343ms")]
- (fact "float-num - reads a floating-point number, delimited"
- (:input s1) => [\m \s]
- (:value s1) => 0.00343
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-1265
- (let [s1 (parse float-num "98765432.19876543555666|")]
- (fact "float-num - reads a floating-point number, delimited"
- (:input s1) => [\|]
- (:value s1) => 9.876543219876544E7
- (:ok s1) => true
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_core.cljc b/src/test/clojure/blancas/kern/test_core.cljc
new file mode 100644
index 0000000..5e1f13a
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_core.cljc
@@ -0,0 +1,3548 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns blancas.kern.test-core
+ (:require [blancas.kern.core :as k :refer [parse value return fail
+ >>= >> <*> <|> <+> << <:> <$>
+ letter digit satisfy many space new-line* tab
+ sym* token* token- word* one-of* none-of* eof
+ many1 optional option skip skip-many skip-many1 sep-by sep-by1 end-by end-by1
+ sep-end-by sep-end-by1 between alpha-num times dec-num]]
+ [blancas.kern.char :as char]
+ [clojure.test :refer [deftest is testing]]
+ [blancas.kern.char :as char])
+ #?(:clj (:require [blancas.kern.core :refer [bind]])
+ :cljs (:require-macros [blancas.kern.core :refer [bind]])))
+
+(defn check-pos [line col pos]
+ (is (= line (:line pos)))
+ (is (= col (:col pos))))
+
+;; +-------------------------------------------------------------+
+;; | Basic parsers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse letter "xyz")
+ s2 ((return 0) s1)]
+ (testing "return"
+ (is (= 0 (:value s2)))
+ (is (:ok s2))
+ (is (nil? (:error s2)))
+ (is (= (:input s1) (:input s2)))
+ (is (= (:empty s1) (:empty s2)))
+ (is (= (:pos s1) (:pos s2)))
+ (is (= (:user s1)))) (:user s2)))
+
+
+(deftest test-0005
+ (let [em "the buck stops here"
+ s1 (parse letter "xyz")
+ s2 ((fail em) s1)]
+ (testing "fail"
+ (is (nil? (:value s2)))
+ (is (false? (:ok s2)))
+ (is (:empty s2))
+ (is (= (k/make-err-message (:pos s1) em) (:error s2)))
+ (is (= (:input s1) (:input s2)))
+ (is (= (:pos s1) (:pos s2)))
+ (is (= (:user s1)))) (:user s2)))
+
+
+(deftest test-0010
+ (let [s1 (parse letter "xyz")
+ s2 ((satisfy char/is-letter) s1)]
+ (testing "satisfy - advances one char"
+ (is (= [\z] (:input s2)))
+ (is (= \y (:value s2)))
+ (is (:ok s2))
+ (is (false? (:empty s2)))
+ (is (= (:user s1) (:user s2)))
+ (is (nil? (:error s2)))
+ (check-pos 1 3 (:pos s2)))))
+
+
+(deftest test-0015
+ (let [s1 (parse letter "u2")
+ s2 ((satisfy char/is-digit) s1)]
+ (testing "satisfy - reaches the end of input"
+ (is (empty? (:input s2)))
+ (is (= \2 (:value s2)))
+ (is (:ok s2))
+ (is (false? (:empty s2)))
+ (is (= (:user s1) (:user s2)))
+ (is (nil? (:error s2)))
+ (check-pos 1 3 (:pos s2)))))
+
+
+(deftest test-0020
+ (let [s1 (parse letter "u\t")
+ s2 ((satisfy #(= \tab %)) s1)]
+ (testing "satisfy - advnaces one tab; default 4 positions"
+ (is (= \tab (:value s2)))
+ (is (:ok s2))
+ (is (false? (:empty s2)))
+ (is (= (:user s1) (:user s2)))
+ (is (nil? (:error s2)))
+ (check-pos 1 6 (:pos s2)))))
+
+
+(deftest test-0025
+ (binding [k/*tab-width* 8]
+ (let [s1 (parse letter "u\t")
+ s2 ((satisfy #(= \tab %)) s1)]
+ (testing "satisfy - advances one tab of 8 positions"
+ (is (= \tab (:value s2)))
+ (is (:ok s2))
+ (is (false? (:empty s2)))
+ (is (= (:user s1) (:user s2)))
+ (is (nil? (:error s2)))
+ (check-pos 1 10 (:pos s2))))))
+
+
+(deftest test-0030
+ (let [s1 (parse letter "u\n")
+ s2 ((satisfy #(= \newline %)) s1)]
+ (testing "satisfy - advances to the next line, first column"
+ (is (= \newline (:value s2)))
+ (is (:ok s2))
+ (is (false? (:empty s2)))
+ (is (= (:user s1) (:user s2)))
+ (is (nil? (:error s2)))
+ (check-pos 2 1 (:pos s2)))))
+
+
+(deftest test-0035
+ (let [em "end of input"
+ s1 (parse (many letter) "xyz")
+ s2 ((satisfy (fn [_] true)) s1)]
+ (testing "satisfy - attempts to read past the end of input"
+ (is (empty? (:input s2)))
+ (is (nil? (:value s2)))
+ (is (false? (:ok s2)))
+ (is (:empty s2))
+ (is (= (:user s1) (:user s2)))
+ (is (= (k/make-err-unexpect (:pos s1) em) (:error s2)))
+ (is (= (:pos s1)))) (:pos s2)))
+
+
+(deftest test-0040
+ (let [em #?(:clj "\\2" :cljs "\"2\"")
+ s1 (parse letter "u2")
+ s2 ((satisfy char/is-letter) s1)]
+ (testing "satisfy - the predicate fails"
+ (is (= [\2] (:input s2)))
+ (is (nil? (:value s2)))
+ (is (false? (:ok s2)))
+ (is (:empty s2))
+ (is (= (:user s1) (:user s2)))
+ (is (= (k/make-err-system (:pos s1) em) (:error s2)))
+ (is (= (:pos s1)))) (:pos s2)))
+
+
+;; +-------------------------------------------------------------+
+;; | Primitive parsers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0045
+ (let [in "#(f %)"
+ s1 (parse k/any-char in)]
+ (testing "any-char"
+ (is (= (rest in) (:input s1)))
+ (is (= \# (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (= (:user s1) (:user s1)))
+ (is (nil? (:error s1)))
+ (check-pos 1 2 (:pos s1)))))
+
+
+(deftest test-0050
+ (let [in "xyz"
+ s1 (parse (>>= k/any-char
+ (fn [a]
+ (>>= k/any-char
+ (fn [b]
+ (>>= k/any-char
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "any-char - three in a row"
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0055
+ (let [em "end of input"
+ s1 (parse k/any-char "")]
+ (testing "any-char - fails on end of input"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= (:user s1) (:user s1)))
+ (is (= (k/make-err-unexpect (:pos s1) em) (:error s1)))
+ (check-pos 1 1 (:pos s1)))))
+
+
+(deftest test-0060
+ (let [in "abc"
+ s1 (parse letter in)]
+ (testing "letter - parses a single letter"
+ (is (= (rest in) (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0065
+ (let [in "xyz"
+ s1 (parse (>>= letter
+ (fn [a]
+ (>>= letter
+ (fn [b]
+ (>>= letter
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "letter - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0070
+ (let [in "123"
+ s1 (parse letter in)]
+ (testing "letter - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0075
+ (let [in "abc"
+ s1 (parse k/lower in)]
+ (testing "k/lower - parses a single k/lower-case letter"
+ (is (= (rest in) (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0080
+ (let [in "xyz"
+ s1 (parse (>>= k/lower
+ (fn [a]
+ (>>= k/lower
+ (fn [b]
+ (>>= k/lower
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "k/lower - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0085
+ (let [in "XYZ"
+ s1 (parse k/lower in)]
+ (testing "k/lower - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0090
+ (let [in "ABC"
+ s1 (parse k/upper in)]
+ (testing "k/upper - parses a single k/upper-case letter"
+ (is (= (rest in) (:input s1)))
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0095
+ (let [in "XYZ"
+ s1 (parse (>>= k/upper
+ (fn [a]
+ (>>= k/upper
+ (fn [b]
+ (>>= k/upper
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "k/upper - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0100
+ (let [in "123"
+ s1 (parse k/upper in)]
+ (testing "k/upper - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0105
+ (let [in " \t\t"
+ s1 (parse k/white-space in)]
+ (testing "k/white-space - parses a single whitespace character"
+ (is (= (rest in) (:input s1)))
+ (is (= \space (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0110
+ (let [in " \t "
+ s1 (parse (>>= k/white-space
+ (fn [a]
+ (>>= k/white-space
+ (fn [b]
+ (>>= k/white-space
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "k/white-space - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0115
+ (let [in "***"
+ s1 (parse k/white-space in)]
+ (testing "k/white-space - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0120
+ (let [in " "
+ s1 (parse space in)]
+ (testing "space - parses a single space character"
+ (is (= (rest in) (:input s1)))
+ (is (= \space (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0125
+ (let [in " "
+ s1 (parse (>>= space
+ (fn [a]
+ (>>= space
+ (fn [b]
+ (>>= space
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "space - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0130
+ (let [in "***"
+ s1 (parse space in)]
+ (testing "space - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0135
+ (let [in "\n\t."
+ s1 (parse new-line* in)]
+ (testing "new-line - parses a single newline character"
+ (is (= (rest in) (:input s1)))
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0140
+ (let [in "\n\n\n"
+ s1 (parse (>>= new-line*
+ (fn [a]
+ (>>= new-line*
+ (fn [b]
+ (>>= new-line*
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "new-line* - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0145
+ (let [in "***"
+ s1 (parse new-line* in)]
+ (testing "new-line* - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0150
+ (let [in "\t|\t|"
+ s1 (parse tab in)]
+ (testing "tab - parses a single tab character"
+ (is (= (rest in) (:input s1)))
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0155
+ (let [in "\t\t\t"
+ s1 (parse (>>= tab
+ (fn [a]
+ (>>= tab
+ (fn [b]
+ (>>= tab
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "tab - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0160
+ (let [in "***"
+ s1 (parse tab in)]
+ (testing "tab - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0165
+ (let [in "12345"
+ s1 (parse digit in)]
+ (testing "digit - parses a single digit"
+ (is (= (rest in) (:input s1)))
+ (is (= \1 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0170
+ (let [in "012"
+ s1 (parse (>>= digit
+ (fn [a]
+ (>>= digit
+ (fn [b]
+ (>>= digit
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "digit - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0175
+ (let [in "***"
+ s1 (parse digit in)]
+ (testing "digit - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0180
+ (let [in "ABCDEF"
+ s1 (parse k/hex-digit in)]
+ (testing "hex-digit - parses a single hex digit"
+ (is (= (rest in) (:input s1)))
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0185
+ (let [in "CAB"
+ s1 (parse (>>= k/hex-digit
+ (fn [a]
+ (>>= k/hex-digit
+ (fn [b]
+ (>>= k/hex-digit
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "hex-digit - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0190
+ (let [in "***"
+ s1 (parse digit in)]
+ (testing "hex-digit - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0195
+ (let [in "12345"
+ s1 (parse k/oct-digit in)]
+ (testing "oct-digit - parses a single octal digit"
+ (is (= (rest in) (:input s1)))
+ (is (= \1 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0200
+ (let [in "567"
+ s1 (parse (>>= k/oct-digit
+ (fn [a]
+ (>>= k/oct-digit
+ (fn [b]
+ (>>= k/oct-digit
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "oct-digit - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0205
+ (let [in "***"
+ s1 (parse digit in)]
+ (testing "oct-digit - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0210
+ (let [in "a0b1"
+ s1 (parse k/alpha-num in)]
+ (testing "alpha-num - parses a single alpha-numeric character"
+ (is (= (rest in) (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0215
+ (let [in "a1b"
+ s1 (parse (>>= k/alpha-num
+ (fn [a]
+ (>>= k/alpha-num
+ (fn [b]
+ (>>= k/alpha-num
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "alpha-num - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0220
+ (let [in "+*&"
+ s1 (parse k/alpha-num in)]
+ (testing "alpha-num - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0225
+ (let [in "X()"
+ s1 (parse (sym* \X) in)]
+ (testing "sym* - parses a single X"
+ (is (= (rest in) (:input s1)))
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0230
+ (let [in "p\t;"
+ s1 (parse (>>= (sym* \p)
+ (fn [a]
+ (>>= (sym* \tab)
+ (fn [b]
+ (>>= (sym* \;)
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "sym* - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0235
+ (let [in "***"
+ s1 (parse (sym* \X) in)]
+ (testing "sym* - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0235-05
+ (let [in "x()"
+ s1 (parse (k/sym- \X) in)]
+ (testing "sym- - parses a single x"
+ (is (= (rest in) (:input s1)))
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0235-10
+ (let [in "X()"
+ s1 (parse (k/sym- \X) in)]
+ (testing "sym- - parses a single X"
+ (is (= (rest in) (:input s1)))
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0235-15
+ (let [in "A()"
+ s1 (parse (k/sym- \X) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "sym- - parses a single X"
+ (is (= [\A \( \)] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= em #?(:clj "unexpected \\A\nexpecting \\X"
+ :cljs "unexpected \"A\"\nexpecting \"X\""))))))
+
+
+(deftest test-0240
+ (let [in "program foo()"
+ s1 (parse (token* "program") in)]
+ (testing "token* - parses a specific word"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0245
+ (let [in "foo(bar)baz"
+ s1 (parse (>>= (token* "foo")
+ (fn [a]
+ (>>= (token* "(bar)")
+ (fn [b]
+ (>>= (token* "baz")
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "token* - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= ["foo" "(bar)" "baz"]))) (:value s1)))
+
+
+(deftest test-0250
+ (let [in "goat"
+ s1 (parse (token* "goal") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "token* - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= em "unexpected goat\nexpecting goal")))))
+
+
+(deftest test-0250-05
+ (let [in "function foo()"
+ s1 (parse (token* "function" "procedure") in)]
+ (testing "token* - parses one of multiple word choices"
+ (is (= (drop (count "function") in) (:input s1)))
+ (is (= "function" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-10
+ (let [in "procedure foo()"
+ s1 (parse (token* "function" "procedure") in)]
+ (testing "token* - parses one of multiple word choices"
+ (is (= (drop (count "procedure") in) (:input s1)))
+ (is (= "procedure" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-15
+ (let [in "program foo()"
+ s1 (parse (token- "PROGRAM") in)]
+ (testing "token- - parses a specific word; non case-sensetive"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "PROGRAM" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-20
+ (let [in "Program foo()"
+ s1 (parse (token- "PROGRAM") in)]
+ (testing "token- - parses a specific word; non case-sensetive"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "PROGRAM" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-25
+ (let [in "PROGRAM foo()"
+ s1 (parse (token- "PROGRAM") in)]
+ (testing "token- - parses a specific word; non case-sensetive"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "PROGRAM" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-30
+ (let [in "goat"
+ s1 (parse (token- "goal") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "token- - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (= em "unexpected goat\nexpecting goal"))))
+
+
+(deftest test-0250-35
+ (let [in "FUNction foo()"
+ s1 (parse (token- "function" "procedure") in)]
+ (testing "token- - parses one of multiple word choices"
+ (is (= (drop (count "function") in) (:input s1)))
+ (is (= "function" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-40
+ (let [in "PROCedure foo()"
+ s1 (parse (token- "function" "procedure") in)]
+ (testing "token- - parses one of multiple word choices"
+ (is (= (drop (count "procedure") in) (:input s1)))
+ (is (= "procedure" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-45
+ (let [in "program foo()"
+ s1 (parse (word* letter "program") in)]
+ (testing "word* - parses a specific, delimited word"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-50
+ (let [in "else{}"
+ s1 (parse (word* letter "else") in)]
+ (testing "word* - parses a specific, delimited word"
+ (is (= [\{ \}] (:input s1)))
+ (is (= "else" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-55
+ (let [in "procedure"
+ s1 (parse (word* letter "proc") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word* - fails because is not delimited"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= em "unexpected e\nexpecting end of proc")))))
+
+
+(deftest test-0250-60
+ (let [in "otherwise{}"
+ s1 (parse (word* letter "else" "otherwise") in)]
+ (testing "word* - parses a specific, delimited word"
+ (is (= [\{ \}] (:input s1)))
+ (is (= "otherwise" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-65
+ (let [in "subroutine"
+ s1 (parse (word* letter "proc" "func" "method") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word* - fails with incorrect input"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= em "unexpected subr\nunexpected subrou\nexpecting proc, func or method")))))
+
+
+(deftest test-0250-70
+ (let [in "PROGRAM foo()"
+ s1 (parse (k/word- letter "program") in)]
+ (testing "word- - parses a specific, delimited word; not case-senstive"
+ (is (= (drop (count "program") in) (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-75
+ (let [in "Else{}"
+ s1 (parse (k/word- letter "else") in)]
+ (testing "word- - parses a specific, delimited word; not case-senstive"
+ (is (= [\{ \}] (:input s1)))
+ (is (= "else" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-80
+ (let [in "ProcEdure"
+ s1 (parse (k/word- letter "proc") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word- - fails because is not delimited"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected E\nexpecting end of proc" em)))))
+
+
+(deftest test-0250-85
+ (let [in "OtherWise{}"
+ s1 (parse (k/word- letter "else" "otherwise") in)]
+ (testing "word- - parses a specific, delimited word; not case-senstive"
+ (is (= [\{ \}] (:input s1)))
+ (is (= "otherwise" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0250-90
+ (let [in "SUBroutine"
+ s1 (parse (k/word- letter "proc" "func" "method") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word- - fails with incorrect input"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected SUBr\nunexpected SUBrou\nexpecting proc, func or method" em)))))
+
+
+(deftest test-0255
+ (let [in "* 2"
+ s1 (parse (one-of* "+-*/^") in)]
+ (testing "one-of* - parses one of the supplied characters"
+ (is (= (rest in) (:input s1)))
+ (is (= \* (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0260
+ (let [in "*-+"
+ op "+-*/"
+ s1 (parse (>>= (one-of* op)
+ (fn [a]
+ (>>= (one-of* op)
+ (fn [b]
+ (>>= (one-of* op)
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "one-of* - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0265
+ (let [in "abc"
+ s1 (parse (one-of* "+-*/") in)]
+ (testing "one-of* - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0270
+ (let [in ": 2"
+ s1 (parse (none-of* "+-*/^") in)]
+ (testing "none-of* - parses a character not supplied"
+ (is (= (rest in) (:input s1)))
+ (is (= \: (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0275
+ (let [in "^&%"
+ op "+-*/"
+ s1 (parse (>>= (none-of* op)
+ (fn [a]
+ (>>= (none-of* op)
+ (fn [b]
+ (>>= (none-of* op)
+ (fn [c]
+ (return [a b c])))))))
+ in)]
+ (testing "none-of* - three in a row until end of input"
+ (is (empty? (:input s1)))
+ (is (= (seq in)))) (:value s1)))
+
+
+(deftest test-0280
+ (let [in "$foo"
+ s1 (parse (none-of* "!@#$%^*()") in)]
+ (testing "none-of* - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0280-05
+ (let [in ""
+ s1 (parse eof in)]
+ (testing "eof - parses an empty string"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1)))))
+
+
+(deftest test-0280-10
+ (let [in "END."
+ s1 (parse (>> (token* "END.") eof) in)]
+ (testing "eof - verifies that input ends"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-15
+ (let [in "END.// the end"
+ s1 (parse (>> (token* "END.") eof) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "eof - verifies that input ends"
+ (is (= (seq "// the end") (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected /\nexpecting end of input" em)))))
+
+
+(deftest test-0280-20
+ (let [in "12\n"
+ s1 (parse (<*> digit digit new-line*) in)]
+ (testing "new-line* - a new line after two digits"
+ (is (empty? (:input s1)))
+ (is (= [\1 \2 \newline] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-25
+ (let [in "AB\r\nCD\r\n"
+ s1 (parse (many1 (<< (many1 k/upper) new-line*)) in)]
+ (testing "new-line* - pairs of letters separated by a new line"
+ (is (empty? (:input s1)))
+ (is (= [[\A \B] [\C \D]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-30
+ (let [in "12345 "
+ s1 (parse (<< (many1 digit) new-line*) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "new-line* - the line doesn't end with a new line"
+ (is (= [\space] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\space\nexpecting new line"
+ :cljs "unexpected \" \"\nexpecting new line")
+ em)))))
+
+
+(deftest test-0280-35
+ (let [in " \t \t \n \t *"
+ s1 (parse (k/skip-ws (sym* \*)) in)]
+ (testing "skip-ws - skips whitespaces before parsing a star"
+ (is (empty? (:input s1)))
+ (is (= \* (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-40
+ (let [in "*"
+ s1 (parse (k/skip-ws (sym* \*)) in)]
+ (testing "skip-ws - nothing to skip before parsing a star"
+ (is (empty? (:input s1)))
+ (is (= \* (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-45
+ (let [in "Now is the time... right... now."
+ s1 (parse (k/field* "!") in)]
+ (testing "field* - reads the whole string"
+ (is (empty? (:input s1)))
+ (is (= in (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-50
+ (let [in "Now is the time; right... now."
+ s1 (parse (k/field* ";") in)]
+ (testing "field* - reads the field delimited by a semicolon"
+ (is (= (seq "; right... now.") (:input s1)))
+ (is (= "Now is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-55
+ (let [in "Now-is-the-time"
+ s1 (parse (k/split-on "-") in)]
+ (testing "field - breaks the string into the words"
+ (is (= ["Now" "is" "the" "time"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-60
+ (let [in "Software,Tooling,495.95,0.00,,15,,xyz"
+ s1 (parse (k/split-on ",") in)]
+ (testing "field - breaks the string into fields; some are empty"
+ (is (= ["Software" "Tooling" "495.95" "0.00" "15" "xyz"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-65
+ (let [in "Now is the time. Or, is it? Yes! yes! that's it."
+ s1 (parse (k/split-on " ,?!.") in)]
+ (testing "field - collects all words; skips the given punctuation"
+ (is (= ["Now" "is" "the" "time" "Or" "is" "it" "Yes" "yes" "that's" "it"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280-70
+ (testing "mark parses a punctuation mark."
+ (is (= \! (value k/mark "!")))
+ (is (= \@ (value k/mark "@")))
+ (is (= \* (value k/mark "*")))
+ (is (= \: (value k/mark ":")))
+ (is (= \/ (value k/mark "/")))
+ (is (= \. (value k/mark ".")))))
+
+
+;; +-------------------------------------------------------------+
+;; | Parser combinators. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0285
+ (let [s1 (parse letter "1")
+ em (-> s1 :error :msgs first :text force)]
+ (testing "first message in the msgs list"
+ (is (= "letter" em)))))
+
+
+(deftest test-0290
+ (let [s1 (parse letter "1")
+ em (k/get-msg-str (:error s1))]
+ (testing "verify error messages"
+ (is (= #?(:clj "unexpected \\1\nexpecting letter"
+ :cljs "unexpected \"1\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0295
+ (let [s1 (parse ( (<*> digit letter) "digit,letter") "01")
+ em (-> s1 :error :msgs first :text force)]
+ (testing " - does not add message when input is consumed"
+ (is (not= "digit,letter" em)))))
+
+
+(deftest test-0300
+ (let [s1 (parse ( (<*> digit letter) "digit,letter") "01")
+ em (k/get-msg-str (:error s1))]
+ (testing " - verifies error messages in <*>"
+ (is (= #?(:clj "unexpected \\1\nexpecting letter"
+ :cljs "unexpected \"1\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0305
+ (let [s1 (parse ( (<*> digit letter) "digit,letter") "0")
+ em (k/get-msg-str (:error s1))]
+ (testing " - verifies error messages in <*>"
+ (is (= "unexpected end of input\nexpecting letter" em)))))
+
+
+(deftest test-0310
+ (let [s1 (parse (<|> digit letter) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - verifies error messages"
+ (is (= #?(:clj "unexpected \\*\nexpecting digit or letter"
+ :cljs "unexpected \"*\"\nexpecting digit or letter")
+ em)))))
+
+
+(deftest test-0315
+ (let [s1 (parse (<|> (sym* \x) (<|> letter digit)) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - verifies error messages with 3 choices"
+ (is (= #?(:clj "unexpected \\*\nexpecting \\x, letter or digit"
+ :cljs "unexpected \"*\"\nexpecting \"x\", letter or digit")
+ em)))))
+
+
+(deftest test-0320
+ (let [s1 (parse (<|> (<|> k/white-space (sym* \x)) (<|> letter digit)) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - verifies error messages with 4 choices"
+ (is (= #?(:clj "unexpected \\*\nexpecting whitespace, \\x, letter or digit"
+ :cljs "unexpected \"*\"\nexpecting whitespace, \"x\", letter or digit")
+ em)))))
+
+
+(deftest test-0320-05
+ (let [s1 (parse (k/expect (<+> letter digit) "number two") "U2")]
+ (testing "expect - parser succeeds"
+ (is (= "U2" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0320-10
+ (let [s1 (parse (k/expect (<+> letter digit) "number two") "UX")
+ em (k/get-msg-str (:error s1))]
+ (testing "expect - parser fails consuming input"
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\X\nexpecting number two"
+ :cljs "unexpected \"X\"\nexpecting number two")
+ em)))))
+
+
+(deftest test-0320-15
+ (let [s1 (parse (k/expect (<+> letter digit) "number two") "007")
+ em (k/get-msg-str (:error s1))]
+ (testing "expect - parser fails without consuming any input"
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= [\0 \0 \7] (:input s1)))
+ (is (= #?(:clj "unexpected \\0\nexpecting number two"
+ :cljs "unexpected \"0\"\nexpecting number two")
+ em)))))
+
+
+(deftest test-0325
+ (let [s1 (parse (<|> letter digit) "U2")]
+ (testing "<|> - the first parser succeeds"
+ (is (= \U (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\2] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0330
+ (let [s1 (parse (<|> digit letter) "XYZ")]
+ (testing "<|> - the second parser succeeds"
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\Y \Z] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0335
+ (let [s1 (parse (<|> (>> letter digit) letter) "XYZ")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - the first parse fails consuming input"
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (= [\Y \Z] (:input s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\Y\nexpecting digit"
+ :cljs "unexpected \"Y\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0340
+ (let [s1 (parse (<|> k/white-space letter digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - verifies error messages with 3 choices"
+ (is (= #?(:clj "unexpected \\*\nexpecting whitespace, letter or digit"
+ :cljs "unexpected \"*\"\nexpecting whitespace, letter or digit")
+ em)))))
+
+
+(deftest test-0345
+ (let [s1 (parse (<|> k/white-space (sym* \x) letter digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<|> - verifies error messages with 4 choices"
+ (is (= #?(:clj "unexpected \\*\nexpecting whitespace, \\x, letter or digit"
+ :cljs "unexpected \"*\"\nexpecting whitespace, \"x\", letter or digit")
+ em)))))
+
+
+(deftest test-0350
+ (let [s1 (parse (<|> k/white-space (sym* \x) letter digit) "\t")]
+ (testing "<|> - the first of 4 parser succeeds"
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0355
+ (let [s1 (parse (<|> k/white-space (sym* \x) letter digit) "x")]
+ (testing "<|> - the second of 4 parser succeeds"
+ (is (= \x (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0360
+ (let [s1 (parse (<|> k/white-space (sym* \x) letter digit) "z")]
+ (testing "<|> - the third of 4 parser succeeds"
+ (is (= \z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0365
+ (let [s1 (parse (<|> k/white-space (sym* \x) letter digit) "0")]
+ (testing "<|> - the fourth parser succeeds"
+ (is (= \0 (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0370
+ (let [p1 (>>= letter (fn [x] (return (char/upper-case x))))
+ s1 (parse p1 "xyz")]
+ (testing ">>= - advances one char"
+ (is (= [\y \z] (:input s1)))
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1)))
+ (check-pos 1 2 (:pos s1)))))
+
+
+(deftest test-0375
+ (let [p1 (>>= digit
+ (fn [x] (>>= digit
+ (fn [y] (return #?(:clj (Integer/parseInt (str x y))
+ :cljs (js/parseInt (str x y))))))))
+ s1 (parse p1 "50113")]
+ (testing ">>= - advances two chars"
+ (is (= [\1 \1 \3] (:input s1)))
+ (is (= 50 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1)))
+ (check-pos 1 3 (:pos s1)))))
+
+
+(deftest test-0380
+ (let [in "012345"
+ p1 (>>= letter (fn [x] (return (int x))))
+ s1 (parse p1 in)
+ em (k/get-msg-str (:error s1))]
+ (testing ">>= - the first parser fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (nil? (:user s1)))
+ (check-pos 1 1 (:pos s1))
+ (is (= #?(:clj "unexpected \\0\nexpecting letter"
+ :cljs "unexpected \"0\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0385
+ (let [p1 (>>= letter (fn [_] digit))
+ s1 (parse p1 "xyz")
+ em (k/get-msg-str (:error s1))]
+ (testing ">>= - the second parser fails"
+ (is (= [\y \z] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (check-pos 1 2 (:pos s1))
+ (is (= #?(:clj "unexpected \\y\nexpecting digit"
+ :cljs "unexpected \"y\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0385-05
+ (let [p1 (bind [x letter] (return (char/upper-case x)))
+ s1 (parse p1 "xyz")]
+
+ (testing "bind - advances one char"
+ (is (= [\y \z] (:input s1)))
+ (is (= \X (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1)))
+ (check-pos 1 2 (:pos s1)))))
+
+
+(deftest test-0385-10
+ (let [p1 (bind [x digit y digit]
+ (return #?(:clj (Integer/parseInt (str x y))
+ :cljs (js/parseInt (str x y)))))
+ s1 (parse p1 "50113")]
+ (testing "bind - advances two chars"
+ (is (= [\1 \1 \3] (:input s1)))
+ (is (= 50 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1)))
+ (check-pos 1 3 (:pos s1)))))
+
+
+(deftest test-0385-15
+ (let [p1 (bind [_ (sym* \()
+ s (<+> (many1 digit))
+ _ (sym* \))]
+ (return (* #?(:clj (Integer/parseInt s) :cljs (js/parseInt s))
+ -1)))
+ s1 (parse p1 "(50113)")]
+ (testing "bind - reads a negative number in parens, as in accounting"
+ (is (empty? (:input s1)))
+ (is (= -50113 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0385-20
+ (let [p1 (bind [x letter]
+ (if (= x \x)
+ (bind [y (sym* \Y)
+ z (sym* \Z)] (return "first"))
+ (bind [n (many1 digit)] (return 5005))))
+ s1 (parse p1 "xYZ")]
+ (testing "bind - uses nested bind inside the first function body"
+ (is (empty? (:input s1)))
+ (is (= "first" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0385-25
+ (let [p1 (bind [x letter]
+ (if (= x \x)
+ (bind [y (sym* \Y)
+ z (sym* \Z)] (return "first"))
+ (bind [n (many1 digit)] (return 666))))
+ s1 (parse p1 "A10002450")]
+ (testing "bind - uses nested bind inside the first function body"
+ (is (empty? (:input s1)))
+ (is (= 666 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0385-30
+ (let [p1 (<|> (bind [x (many1 digit)] (return true))
+ (bind [x (many1 letter)] (return false)))
+ s1 (parse p1 "FALSE")]
+ (testing "bind - the first bind fails, the second succeeds"
+ (is (empty? (:input s1)))
+ (is (false? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:user s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0390
+ (let [p1 (>> (sym* \+) digit)
+ s1 (parse p1 "+1")]
+ (testing ">> - consumes two chars, keeps the second"
+ (is (empty? (:input s1)))
+ (is (= \1 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0395
+ (let [p1 (>> (sym* \+) digit)
+ s1 (parse p1 "01")]
+ (testing ">> - the first parser fails"
+ (is (= [\0 \1] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0400
+ (let [p1 (>> (sym* \+) digit)
+ s1 (parse p1 "+A")]
+ (testing ">> - the second parser fails"
+ (is (= [\A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0405
+ (let [p1 (>> digit digit letter)
+ s1 (parse p1 "01A")]
+ (testing ">> - consumes three chars, keeps the last"
+ (is (empty? (:input s1)))
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0410
+ (let [p1 (>> digit digit digit letter)
+ s1 (parse p1 "012A")]
+ (testing ">> - consumes four chars, keeps the last"
+ (is (empty? (:input s1)))
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0415
+ (let [p1 (>> digit digit digit letter)
+ s1 (parse p1 "A")]
+ (testing ">> - the first fails"
+ (is (= [\A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0420
+ (let [p1 (>> digit digit digit letter)
+ s1 (parse p1 "01A")]
+ (testing ">> - the third fails"
+ (is (= [\A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0425
+ (let [p1 (<< letter (sym* \;))
+ s1 (parse p1 "a;")]
+ (testing "<< - consumes two chars, keeps the first"
+ (is (empty? (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0430
+ (let [p1 (<< letter (sym* \;))
+ s1 (parse p1 "0;")]
+ (testing "<< - the first parser fails"
+ (is (= [\0 \;] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0435
+ (let [p1 (<< letter (sym* \;))
+ s1 (parse p1 "A*")]
+ (testing "<< - the second parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0440
+ (let [p1 (<< k/any-char digit digit)
+ s1 (parse p1 "+01")]
+ (testing "<< - consumes three chars, keeps the first"
+ (is (empty? (:input s1)))
+ (is (= \+ (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0445
+ (let [p1 (<< k/any-char digit digit digit digit)
+ s1 (parse p1 "+0123")]
+ (testing "<< - consumes five chars, keeps the first"
+ (is (empty? (:input s1)))
+ (is (= \+ (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0450
+ (let [p1 (<< k/any-char digit digit digit digit)
+ s1 (parse p1 "+01*")]
+ (testing "<< - the fourth parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0455
+ (let [s1 (parse (<$> count (many k/any-char)) "abcdef+01234*")]
+ (testing "<$> - counts the length of the input"
+ (is (empty? (:input s1)))
+ (is (= 13 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0460
+ (let [s1 (parse (<$> #(- (int %) (int \0)) digit) "9")]
+ (testing "<$> - converts a char digit into an int"
+ (is (empty? (:input s1)))
+ (is (= 9 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0465
+ (let [s1 (parse (<$> #(- (int %) (int \0)) digit) "A")]
+ (testing "<$> - fails and the function is not applied"
+ (is (= [\A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0469-a
+ (let [s1 (parse (<*> digit) "9")]
+ (testing "<*> - collects from one parser"
+ (is (empty? (:input s1)))
+ (is (= [\9] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0469-b
+ (let [s1 (parse (<*> letter) "U2")]
+ (testing "<*> - collects from one parser"
+ (is (= [\2] (:input s1)))
+ (is (= [\U] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0470
+ (let [s1 (parse (<*> (sym* \-) digit) "-1")]
+ (testing "<*> - collects from two parsers"
+ (is (empty? (:input s1)))
+ (is (= [\- \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0475
+ (let [s1 (parse (<*> (sym* \-) digit (sym* \;)) "-1;")]
+ (testing "<*> - collects from three parsers"
+ (is (empty? (:input s1)))
+ (is (= [\- \1 \;] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0480
+ (let [p1 (<*> letter (>> (sym* \|) letter) (>> (sym* \|) digit))
+ s1 (parse p1 "X|Y|9")]
+ (testing "<*> - collects from filtering parsers"
+ (is (empty? (:input s1)))
+ (is (= [\X \Y \9] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0485
+ (let [in "ABC012"
+ p1 (<*> (<*> letter letter letter) (<*> digit digit digit))
+ s1 (parse p1 in)]
+ (testing "<*> - collects from compound parsers"
+ (is (empty? (:input s1)))
+ (is (= '((\A \B \C) (\0 \1 \2)) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0485-05
+ (let [s1 (parse (<*> letter digit) "u2")]
+ (testing "<*> - collects results in a vector"
+ (is (empty? (:input s1)))
+ (is (vector? (:value s1)))
+ (is (= [\u \2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0490
+ (let [s1 (parse (<*> letter digit) "*")]
+ (testing "<*> - the first parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0495
+ (let [s1 (parse (<*> letter digit) "A*")]
+ (testing "<*> - the second parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0500
+ (let [s1 (parse (<*> letter tab digit) "A\t*")]
+ (testing "<*> - the third parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0505
+ (let [p1 (<*> letter tab tab tab tab tab (sym* \x))
+ s1 (parse p1 "A\t\t\t\t\t*")]
+ (testing "<*> - the seventh parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0510
+ (let [s1 (parse (<:> k/lower) "a")]
+ (testing "<:> - parses an item; consumes all input"
+ (is (empty? (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0515
+ (let [s1 (parse (<:> (<$> (partial apply str) (<*> (token* "end") space))) "end ")]
+ (testing "<:> - parses nested items; consumes all input"
+ (is (empty? (:input s1)))
+ (is (= "end " (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0520
+ (let [in "a1b3c4d5e7f8"
+ p1 (<*> letter digit)
+ s1 (parse (<:> (many p1)) in)]
+ (testing "<:> - parses six pairs; consumes all input"
+ (is (empty? (:input s1)))
+ (is (= '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8)) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0525
+ (let [s1 (parse (<:> k/lower) "*&!")]
+ (testing "<:> - fails with parsers consuming no input; consumes no input"
+ (is (= [\* \& \!] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-0530
+ (let [s1 (parse (<:> (<*> k/upper k/lower k/upper)) "Mi*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<:> - fails with parsers consuming input; consumes no input"
+ (is (= [\M \i \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting uppercase letter"
+ :cljs "unexpected \"*\"\nexpecting uppercase letter")
+ em)))))
+
+
+(deftest test-0535
+ (let [s1 (parse (<|> (<:> (>> digit letter)) digit) "1*")
+ em (k/get-msg-str (:error s1))]
+ (testing "<:> - verifies that it allows <|> to test the next choice"
+ (is (= [\*] (:input s1)))
+ (is (= \1 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0540
+ (let [s1 (parse (<|> (<:> letter) digit) "***")
+ em (k/get-msg-str (:error s1))]
+ (testing "<:> - verifies that it carries over the error msg"
+ (is (= [\* \* \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter or digit"
+ :cljs "unexpected \"*\"\nexpecting letter or digit")
+ em)))))
+
+
+(deftest test-0545
+ (let [s1 (parse (many k/lower) "*")]
+ (testing "many - parses zero items"
+ (is (= [\*] (:input s1)))
+ (is (empty? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0550
+ (let [s1 (parse (many k/lower) "a*")]
+ (testing "many - parses one item"
+ (is (= [\*] (:input s1)))
+ (is (= [\a] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0555
+ (let [s1 (parse (many (optional letter)) "ABCDEGFHIJK*")]
+ (testing "many - skips optional items; consumes input though value is empty"
+ (is (= [\*] (:input s1)))
+ (is (= (seq "ABCDEGFHIJK") (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0560
+ (let [in "a1b3c4d5e7f8"
+ p1 (<*> letter digit)
+ s1 (parse (many p1) in)]
+ (testing "many - parses six compound items"
+ (is (empty? (:input s1)))
+ (is (= '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8)) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0560-05
+ (let [s1 (parse (many k/lower) "*")]
+ (testing "many - collects the result in a vector; parses zero items"
+ (is (= [\*] (:input s1)))
+ (is (empty? (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0560-10
+ (let [s1 (parse (many k/lower) "a*")]
+ (testing "many - collects the result in a vector; parses one item"
+ (is (= [\*] (:input s1)))
+ (is (= [\a] (:value s1)))
+
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0565
+ (let [s1 (parse (<|> (many k/lower) (sym* \*)) "*")]
+ (testing "many - consumes no input and succeeds; <|> returns its value"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0570
+ (let [in "a1b3c4d5ee"
+ p1 (<*> letter digit)
+ s1 (parse (many p1) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "many - parses four compound items, then fails in the next compound item"
+ (is (= [\e] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\e\nexpecting digit"
+ :cljs "unexpected \"e\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0575
+ (let [s1 (parse (many1 k/lower) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "many1 - fails with zero items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting lowercase letter"
+ :cljs "unexpected \"*\"\nexpecting lowercase letter")
+ em)))))
+
+
+(deftest test-0580
+ (let [s1 (parse (many1 k/lower) "a*")]
+ (testing "many1 - parses one item"
+ (is (= [\*] (:input s1)))
+ (is (= [\a] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0580-05
+ (let [s1 (parse (many1 k/lower) "a*")]
+ (testing "many1 - collects the result in a vector; parses one item"
+ (is (= [\*] (:input s1)))
+ (is (= [\a] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0585
+ (let [in "a1b3c4d5e7f8"
+ p1 (<*> letter digit)
+ s1 (parse (many1 p1) in)]
+ (testing "many1 - parses six compound items"
+ (is (empty? (:input s1)))
+ (is (= '((\a \1) (\b \3) (\c \4) (\d \5) (\e \7) (\f \8)) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0590
+ (let [s1 (parse (<|> (many1 k/lower) (sym* \*)) "w*")]
+ (testing "many1 - consumes input; <|> returns its value"
+ (is (= [\*] (:input s1)))
+ (is (= [\w] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0595
+ (let [s1 (parse (<|> (many1 digit) k/upper) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "many1 - fails; passes on empty, errors to <|>"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit or uppercase letter"
+ :cljs "unexpected \"*\"\nexpecting digit or uppercase letter")
+ em)))))
+
+
+(deftest test-0600
+ (let [s1 (parse (<|> (many1 digit) k/upper) "A")]
+ (testing "many1 - fails; passes on empty, are cleared in <|>"
+ (is (empty? (:input s1)))
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0605
+ (let [in "a1b3c4d5ee"
+ p1 (<*> letter digit)
+ s1 (parse (many1 p1) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "many1 - parses four compound items, then fails in the next compound item"
+ (is (= [\e] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\e\nexpecting digit"
+ :cljs "unexpected \"e\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0610
+ (let [s1 (parse (optional (<*> k/upper digit)) "U2*")]
+ (testing "optional - parses an optional item"
+ (is (= [\*] (:input s1)))
+ (is (= [\U \2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0615
+ (let [s1 (parse (optional (<*> k/upper digit)) "u2*")]
+ (testing "optional - fails consuming no input"
+ (is (= [\u \2 \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0620
+ (let [s1 (parse (optional (<*> k/upper digit)) "UP*")
+ em (k/get-msg-str (:error s1))]
+ (testing "optional - fails consuming input"
+ (is (= [\P \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\P\nexpecting digit"
+ :cljs "unexpected \"P\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0625
+ (let [p1 (<$> (partial apply str) (<*> (optional k/upper) (sym* \*)))
+ s1 (parse p1 "U*")]
+ (testing "optional - skips the optional char"
+ (is (empty? (:input s1)))
+ (is (= "U*" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0630
+ (let [s1 (parse (option "XY" (<*> k/upper digit)) "U2*")]
+ (testing "option - parses an item"
+ (is (= [\*] (:input s1)))
+ (is (= [\U \2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0635
+ (let [s1 (parse (option "XY" (<*> k/upper digit)) "u2*")]
+ (testing "option - fails without consuming input; produces optional value"
+ (is (= [\u \2 \*] (:input s1)))
+ (is (= "XY" (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0640
+ (let [s1 (parse (option "XY" (<*> k/upper digit)) "UP*")
+ em (k/get-msg-str (:error s1))]
+ (testing "option - fails consuming input"
+ (is (= [\P \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\P\nexpecting digit"
+ :cljs "unexpected \"P\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0640-05
+ (let [s1 (parse (skip (sym* \*)) "*")]
+ (testing "skip - skips a star"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0640-10
+ (let [s1 (parse (skip letter digit) "U2")]
+ (testing "skip - skips a letter and a digit"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0640-15
+ (let [s1 (parse (skip (sym* \*) letter digit (sym* \*)) "*U2*")]
+ (testing "skip - skips a star, a letter, a digit, and a star"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0645
+ (let [s1 (parse (skip-many letter) "*")]
+ (testing "skip-many - skips zero letters"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0650
+ (let [s1 (parse (skip-many (<*> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "skip-many - skips zero compound items; <*> fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0655
+ (let [s1 (parse (skip-many (<*> digit k/lower)) "0x*")]
+ (testing "skip-many - skips one compound item"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0660
+ (let [s1 (parse (skip-many letter) "abcdefghijk*")]
+ (testing "skip-many - skips letters"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0665
+ (let [s1 (parse (skip-many (<*> digit k/lower)) "0x1y2z*")]
+ (testing "skip-many - skips three compound items; consumes no more input"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0670
+ (let [s1 (parse (>> (skip-many (optional digit)) (sym* \*)) "0123456789*")]
+ (testing "skip-many - skips optional items; then consumes more input"
+ (is (empty? (:input s1)))
+ (is (= \* (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0675
+ (let [s1 (parse (skip-many1 letter) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "skip-many1 - fails with zero letters"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter"
+ :cljs "unexpected \"*\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0680
+ (let [s1 (parse (skip-many1 (<*> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "skip-many1 - skips zero compound items; <*> fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit") em)))))
+
+
+(deftest test-0685
+ (let [s1 (parse (skip-many1 (<*> digit k/lower)) "0x*")]
+ (testing "skip-many1 - skips one compound item"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0690
+ (let [s1 (parse (skip-many1 letter) "abcdefghijk*")]
+ (testing "skip-many1 - skips letters"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0695
+ (let [s1 (parse (skip-many1 (<*> digit k/lower)) "0x1y2z*")]
+ (testing "skip-many1 - skips three compound items; consumes no more input"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0700
+ (let [s1 (parse (>> (skip-many1 (optional digit)) (sym* \*)) "0123456789*")]
+ (testing "skip-many1 - skips optional items; then consumes more input"
+ (is (empty? (:input s1)))
+ (is (= \* (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0705
+ (let [s1 (parse (sep-by (sym* \,) digit) "*")]
+ (testing "sep-by - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0710
+ (let [s1 (parse (sep-by (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0715
+ (let [s1 (parse (sep-by (sym* \,) digit) "0*")]
+ (testing "sep-by - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0720
+ (let [s1 (parse (sep-by (sym* \,) (<*> k/upper digit)) "U2*")]
+ (testing "sep-by - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0725
+ (let [s1 (parse (sep-by (sym* \,) (>> letter digit)) "U2,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter"
+ :cljs "unexpected \"*\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0730
+ (let [s1 (parse (sep-by (sym* \,) digit) "0,1*")]
+ (testing "sep-by - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0730-05
+ (let [s1 (parse (sep-by (sym* \,) digit) "0,1*")]
+ (testing "sep-by - collects the result in a vector; two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0735
+ (let [s1 (parse (sep-by (sym* \,) (>> (sym* \+) digit)) "+0,+1*")]
+ (testing "sep-by - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0740
+ (let [p1 (sep-by (many k/white-space) (many letter))
+ s1 (parse p1 "one two \t\t three")]
+ (testing "sep-by - three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "three")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0745
+ (let [s1 (parse (sep-by1 (sym* \,) digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by1 - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0750
+ (let [s1 (parse (sep-by1 (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by1 - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0755
+ (let [s1 (parse (sep-by1 (sym* \,) digit) "0*")]
+ (testing "sep-by1 - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0760
+ (let [s1 (parse (sep-by1 (sym* \,) (<*> k/upper digit)) "U2*")]
+ (testing "sep-by1 - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0765
+ (let [s1 (parse (sep-by1 (sym* \,) (>> letter digit)) "U2,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by1 - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter"
+ :cljs "unexpected \"*\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0770
+ (let [s1 (parse (sep-by1 (sym* \,) digit) "0,1*")]
+ (testing "sep-by1 - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0770-05
+ (let [s1 (parse (sep-by1 (sym* \,) digit) "0,1*")]
+ (testing "sep-by1 - collects the result in a vector; two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0775
+ (let [s1 (parse (sep-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1*")]
+ (testing "sep-by1 - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0780
+ (let [p1 (sep-by1 (many k/white-space) (many letter))
+ s1 (parse p1 "one two \t\t three")]
+ (testing "sep-by1 - three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "three")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0785
+ (let [s1 (parse (sep-by1 (sym* \|) (>> k/upper digit)) "A1|B2|C3|DD,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-by1 - compound item fails after reading several items"
+ (is (= [\D \, \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\D\nexpecting digit"
+ :cljs "unexpected \"D\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0790
+ (let [s1 (parse (end-by (sym* \,) digit) "*")]
+ (testing "end-by - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0800
+ (let [s1 (parse (end-by (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0805
+ (let [s1 (parse (end-by (sym* \,) digit) "0*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by - one item; with no separator it fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting \\,"
+ :cljs "unexpected \"*\"\nexpecting \",\"")
+ em)))))
+
+
+(deftest test-0810
+ (let [s1 (parse (end-by (sym* \,) (<*> k/upper digit)) "U2*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting \\,"
+ :cslj "unexpected \"*\"\nexpecting \",\"")
+ em)))))
+
+
+(deftest test-0815
+ (let [s1 (parse (end-by (sym* \,) (>> letter digit)) "U2,*")]
+ (testing "end-by - there is one item that ends with a separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0820
+ (let [s1 (parse (end-by (sym* \,) digit) "0,1,*")]
+ (testing "end-by - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0820-05
+ (let [s1 (parse (end-by (sym* \,) digit) "0,1,*")]
+ (testing "end-by - collects the result in a vector; two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0825
+ (let [s1 (parse (end-by (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
+ (testing "end-by - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0830
+ (let [p1 (end-by (many k/white-space) (many letter))
+ s1 (parse p1 "one two \t\t three\n")]
+ (testing "end-by - three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "three")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0835
+ (let [s1 (parse (end-by1 (sym* \,) digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by1 - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0840
+ (let [s1 (parse (end-by1 (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by1 - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0845
+ (let [s1 (parse (end-by1 (sym* \,) digit) "0*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by1 - one item; with no separator it fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting \\,"
+ :cljs "unexpected \"*\"\nexpecting \",\"")
+ em)))))
+
+
+(deftest test-0850
+ (let [s1 (parse (end-by1 (sym* \,) (<*> k/upper digit)) "U2*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by1 - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting \\,"
+ :cljs "unexpected \"*\"\nexpecting \",\"")
+ em)))))
+
+
+(deftest test-0855
+ (let [s1 (parse (end-by1 (sym* \,) (>> letter digit)) "U2,*")]
+ (testing "end-by1 - there is one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0860
+ (let [s1 (parse (end-by1 (sym* \,) digit) "0,1,*")]
+ (testing "end-by1 - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0860-05
+ (let [s1 (parse (end-by1 (sym* \,) digit) "0,1,*")]
+ (testing "end-by1 - collects the result in a vector; two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0865
+ (let [s1 (parse (end-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
+ (testing "end-by1 - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0870
+ (let [p1 (end-by1 (many k/white-space) (many letter))
+ s1 (parse p1 "one two \t\t three\n")]
+ (testing "end-by1 - three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "three")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0880
+ (let [s1 (parse (end-by1 (sym* \|) (>> k/upper digit)) "A1|B2|C3|DD,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "end-by1 - compound item fails after reading several items"
+ (is (= [\D \, \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\D\nexpecting digit"
+ :cljs "unexpected \"D\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0885
+ (let [s1 (parse (sep-end-by (sym* \,) digit) "*")]
+ (testing "sep-end-by - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0890
+ (let [s1 (parse (sep-end-by (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-end-by - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0895
+ (let [s1 (parse (sep-end-by (sym* \,) digit) "0*")]
+ (testing "sep-end-by - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0900
+ (let [s1 (parse (sep-by (sym* \,) (<*> k/upper digit)) "U2*")]
+ (testing "sep-by - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0905
+ (let [s1 (parse (sep-end-by (sym* \,) (>> letter digit)) "U2,*")]
+ (testing "sep-end-by - one item ended by the separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0910
+ (let [s1 (parse (sep-end-by (sym* \,) digit) "0,1*")]
+ (testing "sep-end-by - two simple items separated by ,"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0910-05
+ (let [s1 (parse (sep-end-by (sym* \,) digit) "0,1*")]
+ (testing "sep-end-by - collects the result in a vector; two simple items separated by ,"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+(deftest test-0915
+ (let [s1 (parse (sep-end-by (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
+ (testing "sep-end-by - two compound items separated and ended by ,"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0920
+ (let [p1 (sep-end-by (many1 k/white-space) (<*> letter letter letter))
+ s1 (parse p1 "one two\t \tsix\n")]
+ (testing "sep-end-by - three compound items; using many1 to avoid an SO"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "six")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0925
+ (let [s1 (parse (sep-end-by1 (sym* \,) digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-end-by1 - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0930
+ (let [s1 (parse (sep-end-by1 (sym* \,) (>> letter digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-end-by1 - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0935
+ (let [s1 (parse (sep-end-by1 (sym* \,) digit) "0*")]
+ (testing "sep-end-by1 - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0940
+ (let [s1 (parse (sep-end-by1 (sym* \,) (<*> k/upper digit)) "U2*")]
+ (testing "sep-end-by1 - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0950
+ (let [s1 (parse (sep-end-by1 (sym* \,) (>> letter digit)) "U2,*")]
+ (testing "sep-end-by1 - one compound item ended by the separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0960
+ (let [s1 (parse (sep-end-by1 (sym* \,) digit) "0,1*")]
+ (testing "sep-end-by1 - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0965
+ (let [s1 (parse (sep-end-by1 (sym* \,) (>> (sym* \+) digit)) "+0,+1,*")]
+ (testing "sep-end-by1 - two compound items ended by the separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0 \1] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0970
+ (let [p1 (sep-end-by1 k/white-space (<*> letter letter letter))
+ s1 (parse p1 "one two\tsix\n")]
+ (testing "sep-end-by1 - three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "six")) (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0970-05
+ (let [p1 (sep-end-by1 k/white-space (<*> letter letter letter))
+ s1 (parse p1 "one two\tsix\n")]
+ (testing "sep-end-by1 - collects the result in a vector; three compound items"
+ (is (empty? (:input s1)))
+ (is (= (list (seq "one") (seq "two") (seq "six")) (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0970-10
+ (let [p1 (sep-end-by1 k/white-space (many1 letter))
+ s1 (parse p1 "one")]
+ (testing "sep-end-by1 - collects the result in a vector; one compound item"
+ (is (empty? (:input s1)))
+ (is (= [(seq "one")] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0975
+ (let [s1 (parse (sep-end-by1 (sym* \|) (>> k/upper digit)) "A1|B2|C3|DD,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "sep-end-by1 - compound item fails after reading several items"
+ (is (= [\D \, \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\D\nexpecting digit"
+ :cljs "unexpected \"D\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0980
+ (let [s1 (parse (between (sym* \{) (sym* \}) digit) "{0}*")]
+ (testing "between - one item"
+ (is (= [\*] (:input s1)))
+ (is (= \0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0980-05
+ (let [s1 (parse (between (sym* \:) digit) ":0:*")]
+ (testing "between - with same delimiter - one item"
+ (is (= [\*] (:input s1)))
+ (is (= \0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0980-10
+ (let [s1 (parse (between (sym* \|) (many digit)) "|5005|*")]
+ (testing "between - with same delimiter - multiple items"
+ (is (= [\*] (:input s1)))
+ (is (= [\5 \0 \0 \5] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0985
+ (let [p1 (>>= letter
+ (fn [x] (>>= (many alpha-num)
+ (fn [y] (return (cons x y))))))
+ s1 (parse (between (sym* \{) (sym* \}) p1) "{abc101z}*")]
+ (testing "between - one compound item"
+ (is (= [\*] (:input s1)))
+ (is (= (seq "abc101z") (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0990
+ (let [s1 (parse (between (sym* \{) (sym* \}) digit) "(0}*")
+ em (k/get-msg-str (:error s1))]
+ (testing "between - the open parser fails"
+ (is (= [\( \0 \} \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\(\nexpecting \\{"
+ :cljs "unexpected \"(\"\nexpecting \"{\"")
+ em)))))
+
+
+(deftest test-0995
+ (let [s1 (parse (between (sym* \{) (sym* \}) digit) "{0)*")
+ em (k/get-msg-str (:error s1))]
+ (testing "between - the close parser fails"
+ (is (= [\) \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\)\nexpecting \\}"
+ :cljs "unexpected \")\"\nexpecting \"}\"")
+ em)))))
+
+
+(deftest test-1000
+ (let [s1 (parse (times 0 digit) "0*")]
+ (testing "times - zero items"
+ (is (= [\0 \*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1001
+ (let [s1 (parse (times 1 letter) "x")]
+ (testing "times - one item"
+ (is (= [] (:input s1)))
+ (is (= [\x] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1005
+ (let [s1 (parse (times 3 (>> k/any-char letter)) "*a@b$c")]
+ (testing "times - three items"
+ (is (empty? (:input s1)))
+ (is (= [\a \b \c] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1005-05
+ (let [s1 (parse (times 3 (>> k/any-char letter)) "*a@b$c")]
+ (testing "times - collects the result in a vector; three items"
+ (is (empty? (:input s1)))
+ (is (= [\a \b \c] (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1010
+ (let [s1 (parse (times 3 (>> k/any-char letter)) "*a@b$$")
+ em (k/get-msg-str (:error s1))]
+ (testing "times - two items, then fails"
+ (is (= [\$] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\$\nexpecting letter"
+ :cljs "unexpected \"$\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-1015
+ (let [s1 (parse (<$> count (k/look-ahead (many digit))) "12345678")]
+ (testing "look-ahead - succeeds consuming input"
+ (is (= (seq "12345678") (:input s1)))
+ (is (= 8 (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1020
+ (let [s1 (parse (k/look-ahead (many digit)) "YYZ")]
+ (testing "look-ahead - succeeds consuming no input"
+ (is (= [\Y \Y \Z] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1025
+ (let [s1 (parse (k/look-ahead digit) "*")]
+ (testing "look-ahead - fails consuming no input"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1030
+ (let [s1 (parse (k/look-ahead (>> letter digit)) "A*")]
+ (testing "look-ahead - fails consuming no input"
+ (is (= [\A \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1030-05
+ (let [s1 (parse (k/predict (sym* \=)) "=10")]
+ (testing "predict - if p succeeds it consumes no input"
+ (is (= [\= \1 \0] (:input s1)))
+ (is (= \= (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1030-10
+ (let [s1 (parse (k/predict (sym* \=)) "<10")]
+ (testing "predict - if p succeeds it consumes no input"
+ (is (= [\< \1 \0] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-1035
+ (let [s1 (parse (k/not-followed-by digit) "**")]
+ (testing "not-followed-by - succeeds as digit fails"
+ (is (= [\* \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1040
+ (let [s1 (parse (k/not-followed-by (>> letter letter digit)) "xy**")]
+ (testing "not-followed-by - succeeds as compound item fails"
+ (is (= [\x \y \* \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1045
+ (let [s1 (parse (k/not-followed-by (<*> k/upper digit)) "U2*")
+ em (k/get-msg-str (:error s1))]
+ (testing "not-followed-by - fails as the parse succeeds"
+ (is (= [\U \2 \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected [\\U \\2]"
+ :cljs "unexpected [\"U\" \"2\"]")
+ em)))))
+
+
+(deftest test-1050
+ (let [s1 (parse (>> k/upper k/upper k/upper eof) "YYZ")]
+ (testing "eof - there's nothing left"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1055
+ (let [s1 (parse eof "")]
+ (testing "eof - there's nothing to begin with"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1060
+ (let [s1 (parse (<*> k/upper digit eof) "U2*")
+ em (k/get-msg-str (:error s1))]
+ (testing "eof - fails because the input isn't empty"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected *\nexpecting end of input" em)))))
+
+
+(deftest test-1065
+ (let [s1 (parse (k/many-till digit letter) "123456A")]
+ (testing "many-till - parses several numbers, then a letter"
+ (is (empty? (:input s1)))
+ (is (= (seq "123456") (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1065-05
+ (let [s1 (parse (k/many-till digit letter) "123456A")]
+ (testing "many-till - collects the result in a vector; several numbers and a letter"
+ (is (empty? (:input s1)))
+ (is (= (seq "123456") (:value s1)))
+ (is (vector? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1070
+ (let [s1 (parse (k/many-till digit letter) "A*")]
+ (testing "many-till - just the end parser"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1075
+ (let [p1 (>> (token* ""))))
+ s1 (parse p1 "")]
+ (testing "many-till - reads a space between xml comments"
+ (is (empty? (:input s1)))
+ (is (= [\space] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1080
+ (let [p1 (>> (token* ""))))
+ s1 (parse p1 "")]
+ (testing "many-till - reads a word between xml comments"
+ (is (empty? (:input s1)))
+ (is (= (seq "foobar") (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-1085
+ (let [s1 (parse (k/many-till digit letter) "*A")
+ em (k/get-msg-str (:error s1))]
+ (testing "many-till - fails parsing the prefix"
+ (is (= [\* \A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter or digit"
+ :cljs "unexpected \"*\"\nexpecting letter or digit")
+ em)))))
+
+
+(deftest test-1090
+ (let [s1 (parse (k/many-till digit letter) "12345*A")
+ em (k/get-msg-str (:error s1))]
+ (testing "many-till - parses several prefixes and then fails"
+ (is (= [\* \A] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter or digit"
+ :cljs "unexpected \"*\"\nexpecting letter or digit")
+ em)))))
+
+
+(deftest test-1095
+ (let [s1 (parse (k/many-till digit (>> k/upper (sym* \X))) "12345A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "many-till - parses the prefix, then fails reading the end parser"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting \\X"
+ :cljs "unexpected \"*\"\nexpecting \"X\"")
+ em)))))
+
+
+(deftest test-1113
+ (let [s1 (parse (<+> letter) "a")]
+ (testing "<+> - cats from one parser"
+ (is (empty? (:input s1)))
+ (is (= "a" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1114
+ (let [s1 (parse (<+> (times 3 (sym* \S))) "SSS")]
+ (testing "<+> - cats from one parser"
+ (is (empty? (:input s1)))
+ (is (= "SSS" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1115
+ (let [s1 (parse (<+> (sym* \-) digit) "-1")]
+ (testing "<+> - cats from two parsers"
+ (is (empty? (:input s1)))
+ (is (= "-1" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1120
+ (let [s1 (parse (<+> (sym* \-) digit (sym* \;)) "-1;")]
+ (testing "<+> - cats from three parsers"
+ (is (empty? (:input s1)))
+ (is (= "-1;" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1125
+ (let [p1 (<+> letter (>> (sym* \|) letter) (>> (sym* \|) digit))
+ s1 (parse p1 "X|Y|9")]
+ (testing "<+> - cats from filtering parsers"
+ (is (empty? (:input s1)))
+ (is (= "XY9" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1130
+ (let [in "ABC012"
+ p1 (<+> (<*> letter letter letter) (<*> digit digit digit))
+ s1 (parse p1 in)]
+ (testing "<+> - cats from compound parsers"
+ (is (empty? (:input s1)))
+ (is (= "ABC012" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1135
+ (let [s1 (parse (<+> letter digit) "*")]
+ (testing "<+> - the first parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1)))))
+
+
+(deftest test-1140
+ (let [s1 (parse (<+> letter digit) "A*")]
+ (testing "<+> - the second parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1145
+ (let [s1 (parse (<+> letter tab digit) "A\t*")]
+ (testing "<+> - the third parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1150
+ (let [p1 (<+> letter tab tab tab tab tab (sym* \x))
+ s1 (parse p1 "A\t\t\t\t\t*")]
+ (testing "<+> - the seventh parser fails"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1150-05
+ (let [s1 (parse (k/search dec-num) "Now I have 20 dollars")]
+ (testing "search - a simple number"
+ (is (= (seq " dollars") (:input s1)))
+ (is (= 20 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1150-10
+ (let [s1 (parse (many (k/search dec-num)) "Now I have 20 dollars, or 2 tens")]
+ (testing "search - multiple numbers"
+ (is (empty? (:input s1)))
+ (is (= [20 2] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1150-15
+ (let [s1 (parse (many (k/search (<|> dec-num (token* "dollars")))) "Now I have 20 dollars")]
+ (testing "search - multiple choices, multiple times"
+ (is (empty? (:input s1)))
+ (is (= [20 "dollars"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+;; +-------------------------------------------------------------+
+;; | Parser state. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-1155
+ (let [p1 (>> (k/put-state 0)
+ (skip-many
+ (bind [x k/any-char]
+ (if (= x \newline) (k/modify-state inc) (return nil)))))
+ s1 (parse p1 "aaa\nbbb\nccc\nddd\nfff\nggg\nhhh\n\niii\njjj\n\nkkk")]
+ (testing "put-state, modify-state"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (= 11 (:user s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1160
+ (let [p1 (>> (skip (k/put-state 0)
+ (skip-many
+ (bind [x k/any-char]
+ (if (= x \newline) (k/modify-state inc) (return nil)))))
+ k/get-state)
+ s1 (parse p1 "aaa\nbbb\nccc\nddd\nfff\nggg\nhhh\n\niii\njjj\n\nkkk")]
+ (testing "put-state, get-state; get user state as the parser's value"
+ (is (empty? (:input s1)))
+ (is (= 11 (:value s1)))
+ (is (:ok s1))
+ (is (= 11 (:user s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1165
+ (let [in "ABC"
+ p1 (<+> letter letter letter)
+ p2 (>> (k/set-input "XYZ") p1)
+ s1 (parse (<*> p1 p2) in)]
+ (testing "set-input"
+ (is (empty? (:input s1)))
+ (is (= ["ABC" "XYZ"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1170
+ (let [in "ABC"
+ p1 (<+> letter letter letter)
+ p2 (>> (skip (k/set-input "XY0")
+ (k/set-position (k/make-pos "include"))) p1)
+ s1 (parse (<*> p1 p2) in)
+ em (k/get-msg-str (:error s1))
+ ip (:pos s1)]
+ (testing "set-input, set-position"
+ (is (= [\0] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "include" (:src ip)))
+ (is (= 1 (:line ip)))
+ (is (= 3 (:col ip)))
+ (is (= #?(:clj "unexpected \\0\nexpecting letter"
+ :cljs "unexpected \"0\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-1175
+ (let [in "ABC"
+ p1 (<+> letter letter letter)
+ p2 (>> (skip (k/set-input "WXYZ")
+ (k/set-position (k/make-pos "include"))) k/get-position)
+ s1 (parse (>> p1 p2) in)
+ v1 (:value s1)]
+ (testing "set-input, set-position, get-position"
+ (is (= (seq "WXYZ") (:input s1)))
+ (is (= "include" (:src v1)))
+ (is (= 1 (:line v1)))
+ (is (= 1 (:col v1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1180
+ (let [in "ABC"
+ p1 (<+> letter letter letter)
+ p2 (>> (k/set-input "XYZ") k/get-input)
+ s1 (parse (>> p1 p2) in)]
+ (testing "set-input, get-input"
+ (is (= [\X \Y \Z] (:input s1)))
+ (is (= [\X \Y \Z] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+;; +-------------------------------------------------------------+
+;; | Numeric parsers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-1185
+ (let [s1 (parse dec-num "747")]
+ (testing "dec-num - reads a simple integer"
+ (is (empty? (:input s1)))
+ (is (= 747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1190
+ (let [s1 (parse dec-num "747-600")]
+ (testing "dec-num - reads a simple integer, delimited"
+ (is (= [\- \6 \0 \0] (:input s1)))
+ (is (= 747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1195
+ (let [s1 (parse (>> k/upper dec-num) "A380aircraft")]
+ (testing "dec-num - reads an integer, delimited"
+ (is (= (seq "aircraft") (:input s1)))
+ (is (= 380 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1200
+ (let [s1 (parse dec-num "987654321987654321000|")]
+ (testing "dec-num - reads an integer, delimited"
+ (is (= [\|] (:input s1)))
+ (is (= 987654321987654321000N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1205
+ (let [s1 (parse k/oct-num "0747")]
+ (testing "oct-num - reads a simple octal number"
+ (is (empty? (:input s1)))
+ (is (= 0747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1210
+ (let [s1 (parse k/oct-num "0747-600")]
+ (testing "oct-num - reads a simple octal number, delimited"
+ (is (= [\- \6 \0 \0] (:input s1)))
+ (is (= 0747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1215
+ (let [s1 (parse (>> k/upper k/oct-num) "B767aircraft")]
+ (testing "oct-num - reads an octal number, delimited"
+ (is (= (seq "aircraft") (:input s1)))
+ (is (= 0767 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1220
+ (let [s1 (parse k/oct-num "76543217654321000000|")]
+ (testing "oct-num - reads an octal number, delimited"
+ (is (= [\|] (:input s1)))
+ (is (= 076543217654321000000N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1225
+ (let [s1 (parse k/hex-num "747")]
+ (testing "hex-num - reads a simple hex number"
+ (is (empty? (:input s1)))
+ (is (= 0x747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1230
+ (let [s1 (parse k/hex-num "747-600")]
+ (testing "hex-num - reads a simple hex number, delimited"
+ (is (= [\- \6 \0 \0] (:input s1)))
+ (is (= 0x747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1235
+ (let [s1 (parse (>> k/upper k/hex-num) "A380plane")]
+ (testing "hex-num - reads a hex number, delimited"
+ (is (= (seq "plane") (:input s1)))
+ (is (= 0x380 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1240
+ (let [s1 (parse k/hex-num "ABCDEF987654321987654321000|")]
+ (testing "hex-num - reads a hex number, delimited"
+ (is (= [\|] (:input s1)))
+ (is (= 0xABCDEF987654321987654321000N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1245
+ (let [s1 (parse k/float-num "100")]
+ (testing "float-num - reads a simple floating-point number"
+ (is (empty? (:input s1)))
+ (is (= 100.0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1250
+ (let [s1 (parse k/float-num "3.1415927")]
+ (testing "float-num - reads a simple floating-point number"
+ (is (empty? (:input s1)))
+ (is (= 3.1415927 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1255
+ (let [s1 (parse k/float-num "9.8m/s")]
+ (testing "float-num - reads a simple floating-point number, delimited"
+ (is (= [\m \/ \s] (:input s1)))
+ (is (= 9.8 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1260
+ (let [s1 (parse k/float-num "0.00343ms")]
+ (testing "float-num - reads a floating-point number, delimited"
+ (is (= [\m \s] (:input s1)))
+ (is (= 0.00343 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-1265
+ (let [s1 (parse k/float-num "98765432.19876543555666|")]
+ (testing "float-num - reads a floating-point number, delimited"
+ (is (= [\|] (:input s1)))
+ (is (= 9.876543219876544E7 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
diff --git a/src/test/clojure/blancas/kern/test_lexer.clj b/src/test/clojure/blancas/kern/test_lexer.clj
deleted file mode 100644
index 85f68a6..0000000
--- a/src/test/clojure/blancas/kern/test_lexer.clj
+++ /dev/null
@@ -1,2074 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-lexer
- (:use [blancas.kern.core]
- [blancas.kern.lexer.basic]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)])
- (:require [blancas.kern.lexer :as lex]))
-
-;; Private functions from kern.core
-
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-
-
-;; Utility functions.
-
-(defn- get-class
- "Returns the class name of the parser state's value."
- [s] (.getName (class (:value s))))
-
-
-;; +-------------------------------------------------------------+
-;; | Basic lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse (>> trim eof) " \t\t\n")]
- (fact "trim - blank, tab, eol, then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0005
- (let [s1 (parse (>> trim (many digit)) "123")]
- (fact "trim - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0010
- (let [s1 (parse (>> trim (many1 letter)) " \t\n\t\t ABC")]
- (fact "trim - some whitespace before letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0015
- (let [s1 (parse (>> (lexeme (sym* \space)) eof) " \t\t\n")]
- (fact "lexeme - a blank, then tab, eol; then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0020
- (let [s1 (parse (lexeme (many digit)) "123")]
- (fact "lexeme - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0025
- (let [s1 (parse (lexeme (many1 letter)) "ABC \t\n\t\t")]
- (fact "lexeme - some whitespace after letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0030
- (let [s1 (parse new-line "\nfoo")]
- (fact "new-line - parses a new line and stops"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0035
- (let [s1 (parse new-line "\n\t\t foo")]
- (fact "new-line - skip a new line and any other whitespace that follows"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0040
- (let [s1 (parse new-line "\r\nfoo")]
- (fact "new-line - parses a Windows new-line and stops"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0045
- (let [s1 (parse new-line "foo")
- em (get-msg-str (:error s1))]
- (fact "new-line - fails when there's no new-line"
- (:input s1) => [\f \o \o]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\f\nexpecting new line")))
-
-
-(deftest test-0050
- (let [s1 (parse (one-of "+-*/") "+ \n\t4;")]
- (fact "one-of - parses one operator"
- (:value s1) => \+
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\4 \;]
- (:empty s1) => false)))
-
-
-(deftest test-0055
- (let [s1 (parse (one-of "+-*/") "3 + 4;")
- em (get-msg-str (:error s1))]
- (fact "one-of - fails when there's no such operators"
- (:input s1) => (seq "3 + 4;")
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\3")))
-
-
-(deftest test-0060
- (let [s1 (parse (none-of "+-*/") "> \n\t4;")]
- (fact "none-of - parses none of these operators"
- (:value s1) => \>
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\4 \;]
- (:empty s1) => false)))
-
-
-(deftest test-0065
- (let [s1 (parse (none-of "+-*/") "+ 4;")
- em (get-msg-str (:error s1))]
- (fact "none-of - fails when there's one of these operators"
- (:input s1) => (seq "+ 4;")
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\+")))
-
-
-(deftest test-0070
- (let [in "program := foo."
- s1 (parse (token "program") in)]
- (fact "token - parses a specific word, then trims whitespaces"
- (:input s1) => (seq ":= foo.")
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0075
- (let [in "program:= foo."
- s1 (parse (token "program") in)]
- (fact "token - parses a specific word"
- (:input s1) => (seq ":= foo.")
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0080
- (let [in "foo\t (bar)\n\nbaz"
- s1 (parse (>>= (token "foo")
- (fn [a]
- (>>= (token "(bar)")
- (fn [b]
- (>>= (token "baz")
- (fn [c]
- (return [a b c])))))))
- in)]
- (fact "token - three in a row ignoring whitespaces"
- (:input s1) => empty?
- (:value s1) => ["foo" "(bar)" "baz"])))
-
-
-(deftest test-0085
- (let [in "goat"
- s1 (parse (token "goal") in)
- em (get-msg-str (:error s1))]
- (fact "token - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected goat\nexpecting goal")))
-
-
-(deftest test-0090
- (let [in "function f()"
- s1 (parse (token "function" "procedure") in)]
- (fact "token - parses one of multiple word choices"
- (:input s1) => [\f \( \)]
- (:value s1) => "function"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0095
- (let [in "procedure f()"
- s1 (parse (token "function" "procedure") in)]
- (fact "token - parses one of multiple word choices"
- (:input s1) => [\f \( \)]
- (:value s1) => "procedure"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0100
- (let [in "goat"
- s1 (parse (token "goal" "gol" "gal" "moat") in)
- em (get-msg-str (:error s1))]
- (fact "token - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected goat\nunexpected goa\nexpecting goal, gol, gal or moat")))
-
-
-(deftest test-0105
- (let [in "program \t\t foo()"
- s1 (parse (word "program") in)]
- (fact "word - parses a specific, delimited word"
- (:input s1) => [\f \o \o \( \)]
- (:value s1) => "program"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0110
- (let [in "else{}"
- s1 (parse (word "else") in)]
- (fact "word - parses a specific, delimited word"
- (:input s1) => [\{ \}]
- (:value s1) => "else"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0115
- (let [in "procedure"
- s1 (parse (word "proc") in)
- em (get-msg-str (:error s1))]
- (fact "word - fails because is not delimited"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected e\nexpecting end of proc")))
-
-
-(deftest test-0120
- (let [in "foobar()"
- s1 (parse identifier in)]
- (fact "identifier - parses a basic identifier"
- (:input s1) => [\( \)]
- (:value s1) => "foobar"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0125
- (let [in "total_45 := 0;"
- s1 (parse identifier in)]
- (fact "identifier - parses a basic identifier"
- (:input s1) => [\: \= \space \0 \;]
- (:value s1) => "total_45"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0130
- (let [in "4privateUse"
- s1 (parse identifier in)
- em (get-msg-str (:error s1))]
- (fact "identifier - fails with invalid starting char"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\4\nexpecting letter or \\_")))
-
-
-(deftest test-0135
- (let [in "'a' \t\t|;"
- s1 (parse char-lit in)]
- (fact "char-lit - parses a character literal"
- (:input s1) => [\| \;]
- (:value s1) => \a
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0140
- (let [in "'\\n' \t\t|;"
- s1 (parse char-lit in)]
- (fact "char-lit - parses an escaped character literal"
- (:input s1) => [\| \;]
- (:value s1) => \newline
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0145
- (let [in "'\\t' \t\t|;"
- s1 (parse char-lit in)]
- (fact "char-lit - parses an escaped character literal"
- (:input s1) => [\| \;]
- (:value s1) => \tab
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0150
- (let [in "'u2"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails with a missing closing quote"
- (:input s1) => [\2]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\2\nexpecting end of character literal")))
-
-
-(deftest test-0155
- (let [in "u2"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\u\nexpecting character literal")))
-
-
-(deftest test-0160
- (let [in "\"now is the time\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a simple string literal"
- (:input s1) => [\| \;]
- (:value s1) => "now is the time"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0165
- (let [in "\"now\\nis\\tthe\\ttime\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a string with escaped chars"
- (:input s1) => [\| \;]
- (:value s1) => "now\nis\tthe\ttime"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0170
- (let [in "\"now is the time"
- s1 (parse string-lit in)
- em (get-msg-str (:error s1))]
- (fact "string-lit - fails with a string that is not terminated"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected end of input\nexpecting end of string literal")))
-
-
-(deftest test-0175
- (let [in "45 + foobar"
- s1 (parse string-lit in)
- em (get-msg-str (:error s1))]
- (fact "string-lit - fails; not a string"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\4\nexpecting string literal")))
-
-
-(deftest test-0180
- (let [in "+100"
- s1 (parse dec-lit in)]
- (fact "dec-lit - parses a redundant positive sign"
- (:input s1) => empty?
- (:value s1) => 100
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0185
- (let [in "123456789"
- s1 (parse dec-lit in)]
- (fact "dec-lit - parses an integer"
- (:input s1) => empty?
- (:value s1) => 123456789
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0190
- (let [in "1000000000N"
- s1 (parse dec-lit in)]
- (fact "dec-lit - parses a BigInt"
- (:input s1) => empty?
- (:value s1) => 1000000000N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0195
- (let [in "-747"
- s1 (parse dec-lit in)]
- (fact "dec-lit - parses a negative int"
- (:input s1) => empty?
- (:value s1) => -747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0200
- (let [in "9999999999999999999"
- s1 (parse dec-lit in)
- c1 (get-class s1)]
- (fact "dec-lit - promotes a decimal to a BigInt"
- (:input s1) => empty?
- (:value s1) => 9999999999999999999N
- (:ok s1) => true
- (:empty s1) => false
- c1 => "clojure.lang.BigInt")))
-
-(deftest test-0205
- (let [in "100NA"
- s1 (parse dec-lit in)
- em (get-msg-str (:error s1))]
- (fact "dec-lit - fails; no letter can follow N"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected A\nexpecting decimal literal")))
-
-
-(deftest test-0210
- (let [in "100e"
- s1 (parse dec-lit in)
- em (get-msg-str (:error s1))]
- (fact "dec-lit - fails; no letter can follow the last digit"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected e\nexpecting decimal literal")))
-
-
-(deftest test-0215
- (let [in "99."
- s1 (parse dec-lit in)
- em (get-msg-str (:error s1))]
- (fact "dec-lit - fails; the last digit can't be followed by a dot"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected .\nexpecting decimal literal")))
-
-
-(deftest test-0220
- (let [in "0"
- s1 (parse oct-lit in)]
- (fact "oct-lit - zero should be a valid octal number"
- (:input s1) => empty?
- (:value s1) => 0
- (:ok s1) => true
- (:empty s1) => true)))
-
-
-(deftest test-0225
- (let [in "+0100"
- s1 (parse oct-lit in)]
- (fact "oct-lit - parses a redundant positive sign"
- (:input s1) => empty?
- (:value s1) => 64
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0230
- (let [in "012345676543210"
- s1 (parse oct-lit in)]
- (fact "oct-lit - parses an integer"
- (:input s1) => empty?
- (:value s1) => 012345676543210
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0235
- (let [in "03777N"
- s1 (parse oct-lit in)]
- (fact "oct-lit - parses a BigInt"
- (:input s1) => empty?
- (:value s1) => 03777N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0240
- (let [in "-0747"
- s1 (parse oct-lit in)]
- (fact "oct-lit - parses a negative int"
- (:input s1) => empty?
- (:value s1) => -0747
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0245
- (let [in "055555555555555555555N"
- s1 (parse oct-lit in)
- c1 (get-class s1)]
- (fact "oct-lit - promotes a decimal to a BigInt"
- (:input s1) => empty?
- (:value s1) => 055555555555555555555N
- (:ok s1) => true
- (:empty s1) => false
- c1 => "clojure.lang.BigInt")))
-
-(deftest test-0250
- (let [in "0100NA"
- s1 (parse oct-lit in)
- em (get-msg-str (:error s1))]
- (fact "oct-lit - fails; no letter can follow N"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected A\nexpecting octal literal")))
-
-
-(deftest test-0255
- (let [in "0100e"
- s1 (parse oct-lit in)
- em (get-msg-str (:error s1))]
- (fact "oct-lit - fails; no letter can follow the last digit"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected e\nexpecting octal literal")))
-
-
-(deftest test-0260
- (let [in "077."
- s1 (parse oct-lit in)
- em (get-msg-str (:error s1))]
- (fact "oct-lit - fails; the last digit can't be followed by a dot"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected .\nexpecting octal literal")))
-
-
-(deftest test-0265
- (let [in "0x0"
- s1 (parse hex-lit in)]
- (fact "hex-lit - parses a zero"
- (:input s1) => empty?
- (:value s1) => 0
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0270
- (let [in "0XABCDEF"
- s1 (parse hex-lit in)]
- (fact "hex-lit - uses all capial letters"
- (:input s1) => empty?
- (:value s1) => 0xabcdef
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0275
- (let [in "0xabcdef"
- s1 (parse hex-lit in)]
- (fact "hex-lit - uses all capial letters"
- (:input s1) => empty?
- (:value s1) => 0XABCDEF
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0280
- (let [in "+0x100"
- s1 (parse hex-lit in)]
- (fact "hex-lit - parses a redundant positive sign"
- (:input s1) => empty?
- (:value s1) => 0x100
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0285
- (let [in "0xCAFEBABE"
- s1 (parse hex-lit in)]
- (fact "hex-lit - parses an integer"
- (:input s1) => empty?
- (:value s1) => 0xCAFEBABE
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0290
- (let [in "0x00008B55CABA0000N"
- s1 (parse hex-lit in)]
- (fact "hex-lit - parses a BigInt"
- (:input s1) => empty?
- (:value s1) => 0x00008B55CABA0000N
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0295
- (let [in "-0x0F0E"
- s1 (parse hex-lit in)]
- (fact "hex-lit - parses a negative int"
- (:input s1) => empty?
- (:value s1) => -0x0F0E
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0300
- (let [in "0x8000FA7770000B3400400200A"
- s1 (parse hex-lit in)
- c1 (get-class s1)]
- (fact "hex-lit - promotes a decimal to a BigInt"
- (:input s1) => empty?
- (:value s1) => 0x8000FA7770000B3400400200AN
- (:ok s1) => true
- (:empty s1) => false
- c1 => "clojure.lang.BigInt")))
-
-(deftest test-0305
- (let [in "0x100NA"
- s1 (parse hex-lit in)
- em (get-msg-str (:error s1))]
- (fact "hex-lit - fails; no letter can follow N"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected A\nexpecting hex literal")))
-
-
-(deftest test-0310
- (let [in "0x100x"
- s1 (parse hex-lit in)
- em (get-msg-str (:error s1))]
- (fact "hex-lit - fails; no letter can follow the last digit"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected x\nexpecting hex literal")))
-
-
-(deftest test-0315
- (let [in "0x77."
- s1 (parse hex-lit in)
- em (get-msg-str (:error s1))]
- (fact "hex-lit - fails; the last digit can't be followed by a dot"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected .\nexpecting hex literal")))
-
-
-(deftest test-0320
- (let [in "0"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a zero"
- (:input s1) => empty?
- (:value s1) => 0.0
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0325
- (let [in "0.0"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a zero"
- (:input s1) => empty?
- (:value s1) => 0.0
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0330
- (let [in "+100.00"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a redundant positive sign"
- (:input s1) => empty?
- (:value s1) => 100.00
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0335
- (let [in "1558.95"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a floating-point number"
- (:input s1) => empty?
- (:value s1) => 1558.95
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0340
- (let [in "1558.955e12"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a floating-point number with an exponent"
- (:input s1) => empty?
- (:value s1) => 1558.955e12
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0345
- (let [in "1558.9558e-12"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a floating-point number with an exponent"
- (:input s1) => empty?
- (:value s1) => 1558.9558e-12
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0350
- (let [in "1558.9558e+12"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a floating-point number with an exponent"
- (:input s1) => empty?
- (:value s1) => 1558.9558e+12
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0355
- (let [in "-1558.9558e-12"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a negative floating-point number with an exponent"
- (:input s1) => empty?
- (:value s1) => -1558.9558e-12
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0360
- (let [in "1558e12"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a number with no fractional part and an exponent"
- (:input s1) => empty?
- (:value s1) => 1558e12
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0365
- (let [in "3.1415927M"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a BigDecimal"
- (:input s1) => empty?
- (:value s1) => 3.1415927M
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0370
- (let [in "-199.95"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a negative floating-point number"
- (:input s1) => empty?
- (:value s1) => -199.95
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0370-05
- (let [in "999"
- s1 (parse float-lit in)]
- (fact "float-lit - parses a round integer as a floating-point number"
- (:input s1) => empty?
- (:value s1) => 999.0
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0370-10
- (let [in "999"
- s1 (parse float-lit in)]
- (fact "float-lit - regression test: number should not be long"
- (:value s1) =not=> 999)))
-
-
-(deftest test-0375
- (let [in "99.95MA"
- s1 (parse float-lit in)
- em (get-msg-str (:error s1))]
- (fact "float-lit - fails; no letter can follow M"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected A\nexpecting floating-point literal")))
-
-
-(deftest test-0380
- (let [in "99.95X"
- s1 (parse float-lit in)
- em (get-msg-str (:error s1))]
- (fact "float-lit - fails; no letter can follow the last digit"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected X\nexpecting floating-point literal")))
-
-
-(deftest test-0385
- (let [in ".9999"
- s1 (parse float-lit in)
- em (get-msg-str (:error s1))]
- (fact "float-lit - fails; cannot start with a dot"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\.\nexpecting floating-point literal")))
-
-
-(deftest test-0390
- (let [in "true"
- s1 (parse bool-lit in)]
- (fact "bool-lit - true"
- (:input s1) => empty?
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0395
- (let [in "false"
- s1 (parse bool-lit in)]
- (fact "bool-lit - false"
- (:input s1) => empty?
- (:value s1) => false
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0400
- (let [in "true \t \t)"
- s1 (parse bool-lit in)]
- (fact "bool-lit - true with whitespace"
- (:input s1) => [\)]
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0405
- (let [in "false\n\t\t :"
- s1 (parse bool-lit in)]
- (fact "bool-lit - false with whitespace"
- (:input s1) => [\:]
- (:value s1) => false
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0410
- (let [in "nil"
- s1 (parse nil-lit in)]
- (fact "nil-lit - nil"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0415
- (let [in "null"
- s1 (parse nil-lit in)]
- (fact "nil-lit - null"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0420
- (let [in "nil \t \t)"
- s1 (parse nil-lit in)]
- (fact "nil-lit - nil with whitespace"
- (:input s1) => [\)]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0425
- (let [in "null\n\t\t :"
- s1 (parse nil-lit in)]
- (fact "nil-lit - null with whitespace"
- (:input s1) => [\:]
- (:value s1) => nil
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0430
- (let [in "(true)"
- s1 (parse (parens bool-lit) in)]
- (fact "parens - true"
- (:input s1) => empty?
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0435
- (let [in "()"
- s1 (parse (parens (many dec-lit)) in)]
- (fact "parens - nothing"
- (:input s1) => empty?
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0440
- (let [in "( 11 22 33 44 55 )"
- s1 (parse (parens (many1 dec-lit)) in)]
- (fact "parens - true"
- (:input s1) => empty?
- (:value s1) => [11 22 33 44 55]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0445
- (let [in "11 22 33)"
- s1 (parse (parens (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "parens - fails; no starting paren"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\1\nexpecting \\(")))
-
-
-(deftest test-0450
- (let [in "(11 22 33 ;"
- s1 (parse (parens (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "parens - fails; no ending paren"
- (:input s1) => [\;]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\;\nexpecting \\)")))
-
-
-(deftest test-0455
- (let [in "()"
- s1 (parse (parens dec-lit) in)
- em (get-msg-str (:error s1))]
- (fact "parens - fails; missing value"
- (:input s1) => [\)]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\)\nexpecting decimal literal")))
-
-
-(deftest test-0460
- (let [in "{true}"
- s1 (parse (braces bool-lit) in)]
- (fact "braces - true"
- (:input s1) => empty?
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0465
- (let [in "{}"
- s1 (parse (braces (many dec-lit)) in)]
- (fact "braces - nothing"
- (:input s1) => empty?
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0470
- (let [in "{ 11 22 33 44 55 }"
- s1 (parse (braces (many1 dec-lit)) in)]
- (fact "braces - true"
- (:input s1) => empty?
- (:value s1) => [11 22 33 44 55]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0475
- (let [in "11 22 33}"
- s1 (parse (braces (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "braces - fails; no starting brace"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\1\nexpecting \\{")))
-
-
-(deftest test-0480
- (let [in "{11 22 33 ;"
- s1 (parse (braces (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "braces - fails; no ending brace"
- (:input s1) => [\;]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\;\nexpecting \\}")))
-
-
-(deftest test-0485
- (let [in "{}"
- s1 (parse (braces dec-lit) in)
- em (get-msg-str (:error s1))]
- (fact "braces - fails; missing value"
- (:input s1) => [\}]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\}\nexpecting decimal literal")))
-
-
-(deftest test-0490
- (let [in ""
- s1 (parse (angles bool-lit) in)]
- (fact "angles - true"
- (:input s1) => empty?
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0495
- (let [in "<>"
- s1 (parse (angles (many dec-lit)) in)]
- (fact "angles - nothing"
- (:input s1) => empty?
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0500
- (let [in "< 11 22 33 44 55 >"
- s1 (parse (angles (many1 dec-lit)) in)]
- (fact "angles - true"
- (:input s1) => empty?
- (:value s1) => [11 22 33 44 55]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0505
- (let [in "11 22 33>"
- s1 (parse (angles (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "angles - fails; no starting angle bracket"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\1\nexpecting \\<")))
-
-
-(deftest test-0510
- (let [in "<11 22 33 ;"
- s1 (parse (angles (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "angles - fails; no ending angle bracket"
- (:input s1) => [\;]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\;\nexpecting \\>")))
-
-
-(deftest test-0515
- (let [in "<>"
- s1 (parse (angles dec-lit) in)
- em (get-msg-str (:error s1))]
- (fact "angles - fails; missing value"
- (:input s1) => [\>]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\>\nexpecting decimal literal")))
-
-
-(deftest test-0520
- (let [in "[true]"
- s1 (parse (brackets bool-lit) in)]
- (fact "brackets - true"
- (:input s1) => empty?
- (:value s1) => true
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0525
- (let [in "[]"
- s1 (parse (brackets (many dec-lit)) in)]
- (fact "brackets - nothing"
- (:input s1) => empty?
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0530
- (let [in "[ 11 22 33 44 55 ]"
- s1 (parse (brackets (many1 dec-lit)) in)]
- (fact "brackets - true"
- (:input s1) => empty?
- (:value s1) => [11 22 33 44 55]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0535
- (let [in "11 22 33]"
- s1 (parse (brackets (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "brackets - fails; no starting bracket"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\1\nexpecting \\[")))
-
-
-(deftest test-0540
- (let [in "[11 22 33 ;"
- s1 (parse (brackets (many1 dec-lit)) in)
- em (get-msg-str (:error s1))]
- (fact "brackets - fails; no ending bracket"
- (:input s1) => [\;]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\;\nexpecting \\]")))
-
-
-(deftest test-0545
- (let [in "[]"
- s1 (parse (brackets dec-lit) in)
- em (get-msg-str (:error s1))]
- (fact "brackets - fails; missing value"
- (:input s1) => [\]]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\]\nexpecting decimal literal")))
-
-
-(deftest test-0550
- (let [in ";\n\n"
- s1 (parse semi in)]
- (fact "semi"
- (:input s1) => empty?
- (:value s1) => \;
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0555
- (let [in "+"
- s1 (parse semi in)
- em (get-msg-str (:error s1))]
- (fact "semi - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\+\nexpecting \\;")))
-
-
-(deftest test-0560
- (let [in ",\n\n"
- s1 (parse comma in)]
- (fact "comma"
- (:input s1) => empty?
- (:value s1) => \,
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0565
- (let [in "+"
- s1 (parse comma in)
- em (get-msg-str (:error s1))]
- (fact "comma - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\+\nexpecting \\,")))
-
-
-(deftest test-0570
- (let [in ":\n\n"
- s1 (parse colon in)]
- (fact "colon"
- (:input s1) => empty?
- (:value s1) => \:
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0575
- (let [in "+"
- s1 (parse colon in)
- em (get-msg-str (:error s1))]
- (fact "colon - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\+\nexpecting \\:")))
-
-
-(deftest test-0580
- (let [in ".\n\n"
- s1 (parse dot in)]
- (fact "comma"
- (:input s1) => empty?
- (:value s1) => \.
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0585
- (let [in "+"
- s1 (parse dot in)
- em (get-msg-str (:error s1))]
- (fact "dot - fails"
- (:input s1) => (seq in)
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\+\nexpecting \\.")))
-
-
-(deftest test-0590
- (let [s1 (parse (semi-sep digit) "*")]
- (fact "semi-sep - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0595
- (let [s1 (parse (semi-sep (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0600
- (let [s1 (parse (semi-sep digit) "0*")]
- (fact "semi-sep - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0605
- (let [s1 (parse (semi-sep (<*> upper digit)) "U2*")]
- (fact "semi-sep - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0610
- (let [s1 (parse (semi-sep (>> letter digit)) "U2;*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter")))
-
-
-(deftest test-0615
- (let [s1 (parse (semi-sep dec-lit) "550; 101*")]
- (fact "semi-sep - two simple items"
- (:input s1) => [\*]
- (:value s1) => [550 101]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0620
- (let [s1 (parse (semi-sep hex-lit) "+0xFADE ; -0x7800 *")]
- (fact "semi-sep - two compound items"
- (:input s1) => [\*]
- (:value s1) => [0xFADE -0x7800]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0625
- (let [p1 (semi-sep identifier)
- s1 (parse p1 "one ;\n two ; \t\t three")]
- (fact "semi-sep - three compound items"
- (:input s1) => empty?
- (:value s1) => ["one" "two" "three"]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0630
- (let [s1 (parse (semi-sep1 digit) "*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep1 - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0635
- (let [s1 (parse (semi-sep1 (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep1 - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0640
- (let [s1 (parse (semi-sep1 dec-lit) "747*")]
- (fact "semi-sep1 - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [747]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0645
- (let [s1 (parse (semi-sep1 (<*> upper digit)) "U2*")]
- (fact "semi-sep1 - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0650
- (let [s1 (parse (semi-sep1 identifier) "U2;*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep1 - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter or \\_")))
-
-
-(deftest test-0655
- (let [s1 (parse (semi-sep1 dec-lit) "100;200*")]
- (fact "semi-sep1 - two simple items"
- (:input s1) => [\*]
- (:value s1) => [100 200]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0660
- (let [s1 (parse (semi-sep1 dec-lit) "-100 \t \t;\n +200*")]
- (fact "semi-sep1 - two compound items with whitespace"
- (:input s1) => [\*]
- (:value s1) => [-100 200]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0665
- (let [p1 (semi-sep1 identifier)
- s1 (parse p1 "one ;\n\n two \t\t;\n\t three")]
- (fact "semi-sep1 - three compound items"
- (:input s1) => empty?
- (:value s1) => ["one" "two" "three"]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0670
- (let [s1 (parse (semi-sep1 (>> upper digit)) "A1; B2; \tC3;DD;*")
- em (get-msg-str (:error s1))]
- (fact "semi-sep1 - compound item fails after reading several items"
- (:input s1) => [\D \; \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\D\nexpecting digit")))
-
-
-(deftest test-0675
- (let [s1 (parse (comma-sep digit) "*")]
- (fact "comma-sep - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => []
- (:ok s1) => true
- (:empty s1) => true
- (:error s1) => nil)))
-
-
-(deftest test-0680
- (let [s1 (parse (comma-sep (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0685
- (let [s1 (parse (comma-sep digit) "0*")]
- (fact "comma-sep - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [\0]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0690
- (let [s1 (parse (comma-sep (<*> upper digit)) "U2*")]
- (fact "comma-sep - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0695
- (let [s1 (parse (comma-sep (>> letter digit)) "U2,*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter")))
-
-
-(deftest test-0700
- (let [s1 (parse (comma-sep dec-lit) "550, 101*")]
- (fact "comma-sep - two simple items"
- (:input s1) => [\*]
- (:value s1) => [550 101]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0705
- (let [s1 (parse (comma-sep hex-lit) "+0xFADE , -0x7800 *")]
- (fact "comma-sep - two compound items"
- (:input s1) => [\*]
- (:value s1) => [0xFADE -0x7800]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0710
- (let [p1 (comma-sep identifier)
- s1 (parse p1 "one ,\n two , \t\t three")]
- (fact "comma-sep - three compound items"
- (:input s1) => empty?
- (:value s1) => ["one" "two" "three"]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0715
- (let [s1 (parse (comma-sep1 digit) "*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep1 - there are no separated items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0720
- (let [s1 (parse (comma-sep1 (>> letter digit)) "A*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep1 - there are no separated compound items"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting digit")))
-
-
-(deftest test-0725
- (let [s1 (parse (comma-sep1 dec-lit) "747*")]
- (fact "comma-sep1 - one item, no separator"
- (:input s1) => [\*]
- (:value s1) => [747]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0730
- (let [s1 (parse (comma-sep1 (<*> upper digit)) "U2*")]
- (fact "comma-sep1 - one compound item, no separator"
- (:input s1) => [\*]
- (:value s1) => [[\U \2]]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0735
- (let [s1 (parse (comma-sep1 identifier) "U2,*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep1 - there is only one item and the separator"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting letter or \\_")))
-
-
-(deftest test-0740
- (let [s1 (parse (comma-sep1 dec-lit) "100,200*")]
- (fact "comma-sep1 - two simple items"
- (:input s1) => [\*]
- (:value s1) => [100 200]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0745
- (let [s1 (parse (comma-sep1 dec-lit) "-100 \t \t,\n +200*")]
- (fact "comma-sep1 - two compound items with whitespace"
- (:input s1) => [\*]
- (:value s1) => [-100 200]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0750
- (let [p1 (comma-sep1 identifier)
- s1 (parse p1 "one ,\n\n two \t\t,\n\t three")]
- (fact "comma-sep1 - three compound items"
- (:input s1) => empty?
- (:value s1) => ["one" "two" "three"]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0755
- (let [s1 (parse (comma-sep1 (>> upper digit)) "A1, B2, \tC3,DD,*")
- em (get-msg-str (:error s1))]
- (fact "comma-sep1 - compound item fails after reading several items"
- (:input s1) => [\D \, \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\D\nexpecting digit")))
-
-
-(deftest test-0760
- (let [s1 (parse char-lit "'z'")]
- (fact "char-lit"
- (:value s1) => \z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0765
- (let [s1 (parse char-lit "'\\b'")]
- (fact "char-lit"
- (:value s1) => \backspace
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0770
- (let [s1 (parse char-lit "'\\t'")]
- (fact "char-lit"
- (:value s1) => \tab
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0775
- (let [s1 (parse char-lit "'\\n'")]
- (fact "char-lit"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0780
- (let [s1 (parse char-lit "'\\f'")]
- (fact "char-lit"
- (:value s1) => \formfeed
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0785
- (let [s1 (parse char-lit "'\\r'")]
- (fact "char-lit"
- (:value s1) => \return
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0790
- (let [s1 (parse char-lit "'\\''")]
- (fact "char-lit"
- (:value s1) => \'
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0795
- (let [s1 (parse char-lit "'\\\"'")]
- (fact "char-lit"
- (:value s1) => \"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0800
- (let [s1 (parse char-lit "'\\\\'")]
- (fact "char-lit"
- (:value s1) => \\
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0805
- (let [s1 (parse char-lit "'\\/'")]
- (fact "char-lit"
- (:value s1) => \/
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-(deftest test-0810
- (let [in "'a "
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails without the closing quote"
- (:input s1) => [\space]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\space\nexpecting end of character literal")))
-
-
-(deftest test-0815
- (let [in "'\\n "
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails without the closing quote"
- (:input s1) => [\space]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\space\nexpecting end of character literal")))
-
-
-(deftest test-0820
- (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a string with multiple escaped characters"
- (:input s1) => [\| \;]
- (:value s1) => "\bnow\tis\nthe\ftime\r"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-;; +-------------------------------------------------------------+
-;; | Custom lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0820-05
- (let [rec (lex/make-parsers (assoc lex/shell-style :line-continuation (sym* \?)))]
- (lex/with-parsers rec
- (let [in "foo bar foobar ?\n\t\tbaz"
- s1 (parse (many1 lex/identifier) in)]
- (fact "trim - line continuation with a ?"
- (:input s1) => empty?
- (:value s1) => ["foo" "bar" "foobar" "baz"]
- (:ok s1) => true
- (:empty s1) => false)))))
-
-
-(deftest test-0825
- (let [rec (lex/make-parsers (assoc lex/c-style :case-sensitive false))]
- (lex/with-parsers rec
- (let [in "WhIlE (..."
- s1 (parse (lex/word "while") in)]
- (fact "word - non-case-sensitive"
- (:input s1) => [\( \. \. \.]
- (:value s1) => "while"
- (:ok s1) => true
- (:empty s1) => false)))))
-
-
-(deftest test-0830
- (let [rec (lex/make-parsers (assoc lex/c-style :nested-comments true))]
- (lex/with-parsers rec
- (let [in "foo /***outter /* inner comment */ end of outer***/"
- s1 (parse lex/identifier in)]
- (fact "word - nested comments"
- (:input s1) => empty?
- (:value s1) => "foo"
- (:ok s1) => true
- (:empty s1) => false)))))
-
-
-(deftest test-0845
- (let [rec (lex/make-parsers (assoc lex/c-style :reserved-names ["foo" "bar"]))]
- (lex/with-parsers rec
- (let [in "foobar * baz"
- s1 (parse lex/identifier in)]
- (fact "word - valid word, not a reserved word"
- (:value s1) => "foobar"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\* \space \b \a \z]
- (:empty s1) => false)))))
-
-
-(deftest test-0850
- (let [rec (lex/make-parsers (assoc lex/c-style :reserved-names ["foo" "bar"]))]
- (lex/with-parsers rec
- (let [in "foo * bar"
- s1 (parse lex/identifier in)
- em (get-msg-str (:error s1))]
- (fact "word - fails on a reserved word"
- (:input s1) => [\f \o \o \space \* \space \b \a \r]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "foo is a reserved name")))))
-
-
-(deftest test-0855
- (let [rec (lex/make-parsers (assoc lex/c-style
- :case-sensitive false
- :reserved-names ["foo" "bar"]))]
- (lex/with-parsers rec
- (let [in "FOO * bar"
- s1 (parse lex/identifier in)
- em (get-msg-str (:error s1))]
- (fact "word - fails on a reserved word"
- (:input s1) => [\F \O \O \space \* \space \b \a \r]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "FOO is a reserved name")))))
-
-
-(deftest test-0860
- (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
- (lex/with-parsers rec
- (let [in "5005"
- s1 (parse lex/dec-lit in)]
- (fact "dec-lit - regular case, no leading sign."
- (:input s1) => empty?
- (:value s1) => 5005
- (:ok s1) => true
- (:empty s1) => false)))))
-
-
-(deftest test-0865
- (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
- (lex/with-parsers rec
- (let [in "0xCAFE"
- s1 (parse lex/hex-lit in)]
- (fact "hex-lit - regular case, no leading sign."
- (:input s1) => empty?
- (:value s1) => 0xCAFE
- (:ok s1) => true
- (:empty s1) => false)))))
-
-
-(deftest test-0870
- (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
- (lex/with-parsers rec
- (let [in "-5005"
- s1 (parse lex/dec-lit in)]
- (fact "dec-lit - with leading sign it fails."
- (:input s1) => (seq "-5005")
- (:value s1) => nil
- (:ok s1) => false)))))
-
-
-(deftest test-0875
- (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
- (lex/with-parsers rec
- (let [in "+3.1416"
- s1 (parse lex/float-lit in)]
- (fact "float-lit - with leading sign it fails."
- (:input s1) => (seq "+3.1416")
- (:value s1) => nil
- (:ok s1) => false)))))
-
-
-;; +-------------------------------------------------------------+
-;; | Repeating Patterns. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0900
- (let [s1 (parse identifier "f")]
- (fact "identifier -- state must not be empty"
- (:value s1) => "f"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0905
- (let [s1 (parse (many identifier) "f")]
- (fact "identifier -- many should work with a single-letter id"
- (:value s1) => ["f"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0910
- (let [s1 (parse (comma-sep identifier) "f")]
- (fact "multiple identifier"
- (:value s1) => ["f"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0915
- (let [s1 (parse (many (sym \Q)) "QQQ")]
- (fact "multiple symbols"
- (:value s1) => [\Q \Q \Q]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0920
- (let [s1 (parse (many (one-of "abc")) "a b c")]
- (fact "many one-of"
- (:value s1) => [\a \b \c]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0925
- (let [s1 (parse (many (none-of "abc")) "xyz")]
- (fact "many none-of"
- (:value s1) => [\x \y \z]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0930
- (let [s1 (parse (many (token "abc")) "abcabc abc")]
- (fact "many token"
- (:value s1) => ["abc" "abc" "abc"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0935
- (let [s1 (parse (many0 (token "abc")) "xxx")]
- (fact "many0, nothing match but empty is cleared"
- (:value s1) => []
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => (seq "xxx")
- (:empty s1) => false)))
-
-
-(deftest test-0940
- (let [s1 (parse (many (field " ")) "now is the time")]
- (fact "many field"
- (:value s1) => ["now" "is" "the" "time"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0945
- (let [s1 (parse (many (field " ")) "x y")]
- (fact "many token"
- (:value s1) => ["x" "y"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0950
- (let [s1 (parse (many dec-lit) "0")]
- (fact "many dec-lit"
- (:value s1) => [0]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0955
- (let [s1 (parse (many oct-lit) "01")]
- (fact "many oct-lit"
- (:value s1) => [1]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0960
- (let [s1 (parse (many hex-lit) "0x1")]
- (fact "many hex-lit"
- (:value s1) => [1]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0965
- (let [s1 (parse (many float-lit) "1")]
- (fact "many float-lit"
- (:value s1) => [1.0]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_lexer.cljc b/src/test/clojure/blancas/kern/test_lexer.cljc
new file mode 100644
index 0000000..63b1c11
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_lexer.cljc
@@ -0,0 +1,2145 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, fro-m this software.
+
+(ns blancas.kern.test-lexer
+ (:require [blancas.kern.core :as k :refer [parse >> >>= <*>]]
+ [blancas.kern.lexer.basic :as lex-basic]
+ [clojure.test :refer [deftest is testing]]
+ [blancas.kern.lexer :as lex])
+ #?(:cljs (:require-macros [blancas.kern.lexer :as lex])))
+
+;; Utility functions.
+
+(defn- get-class
+ "Returns the class name of the parser state's value."
+ [s] (str (type (:value s))))
+
+
+;; +-------------------------------------------------------------+
+;; | Basic lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse (>> lex-basic/trim k/eof) " \t\t\n")]
+ (testing "trim - blank, tab, eol, then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0005
+ (let [s1 (parse (>> lex-basic/trim (k/many k/digit)) "123")]
+ (testing "trim - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0010
+ (let [s1 (parse (>> lex-basic/trim (k/many1 k/letter)) " \t\n\t\t ABC")]
+ (testing "trim - some whitespace before letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0015
+ (let [s1 (parse (>> (lex-basic/lexeme (k/sym* \space)) k/eof) " \t\t\n")]
+ (testing "lexeme - a blank, then tab, eol; then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0020
+ (let [s1 (parse (lex-basic/lexeme (k/many k/digit)) "123")]
+ (testing "lexeme - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0025
+ (let [s1 (parse (lex-basic/lexeme (k/many1 k/letter)) "ABC \t\n\t\t")]
+ (testing "lexeme - some whitespace after letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0030
+ (let [s1 (parse lex-basic/new-line "\nfoo")]
+ (testing "new-line - parses a new line and stops"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0035
+ (let [s1 (parse lex-basic/new-line "\n\t\t foo")]
+ (testing "new-line - skip a new line and any other whitespace that follows"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0040
+ (let [s1 (parse lex-basic/new-line "\r\nfoo")]
+ (testing "new-line - parses a Windows new-line and stops"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0045
+ (let [s1 (parse lex-basic/new-line "foo")
+ em (k/get-msg-str (:error s1))]
+ (testing "new-line - fails when there's no new-line"
+ (is (= [\f \o \o] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\f\nexpecting new line"
+ :cljs "unexpected \"f\"\nexpecting new line")
+ em)))))
+
+
+(deftest test-0050
+ (let [s1 (parse (lex-basic/one-of "+-*/") "+ \n\t4;")]
+ (testing "one-of - parses one operator"
+ (is (= \+ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\4 \;] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0055
+ (let [s1 (parse (lex-basic/one-of "+-*/") "3 + 4;")
+ em (k/get-msg-str (:error s1))]
+ (testing "one-of - fails when there's no such operators"
+ (is (= (seq "3 + 4;") (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\3"
+ :cljs "unexpected \"3\"")
+ em)))))
+
+
+(deftest test-0060
+ (let [s1 (parse (lex-basic/none-of "+-*/") "> \n\t4;")]
+ (testing "none-of - parses none of these operators"
+ (is (= \> (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\4 \;] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0065
+ (let [s1 (parse (lex-basic/none-of "+-*/") "+ 4;")
+ em (k/get-msg-str (:error s1))]
+ (testing "none-of - fails when there's one of these operators"
+ (is (= (seq "+ 4;") (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\+"
+ :cljs "unexpected \"+\"")
+ em)))))
+
+
+(deftest test-0070
+ (let [in "program := foo."
+ s1 (parse (lex-basic/token "program") in)]
+ (testing "token - parses a specific word, then trims whitespaces"
+ (is (= (seq ":= foo.") (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0075
+ (let [in "program:= foo."
+ s1 (parse (lex-basic/token "program") in)]
+ (testing "token - parses a specific word"
+ (is (= (seq ":= foo.") (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0080
+ (let [in "foo\t (bar)\n\nbaz"
+ s1 (parse (>>= (lex-basic/token "foo")
+ (fn [a]
+ (>>= (lex-basic/token "(bar)")
+ (fn [b]
+ (>>= (lex-basic/token "baz")
+ (fn [c]
+ (k/return [a b c])))))))
+ in)]
+ (testing "token - three in a row ignoring whitespaces"
+ (is (empty? (:input s1)))
+ (is (= ["foo" "(bar)" "baz"]))) (:value s1)))
+
+
+(deftest test-0085
+ (let [in "goat"
+ s1 (parse (lex-basic/token "goal") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "token - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected goat\nexpecting goal" em)))))
+
+
+(deftest test-0090
+ (let [in "function f()"
+ s1 (parse (lex-basic/token "function" "procedure") in)]
+ (testing "token - parses one of multiple word choices"
+ (is (= [\f \( \)] (:input s1)))
+ (is (= "function" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0095
+ (let [in "procedure f()"
+ s1 (parse (lex-basic/token "function" "procedure") in)]
+ (testing "token - parses one of multiple word choices"
+ (is (= [\f \( \)] (:input s1)))
+ (is (= "procedure" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0100
+ (let [in "goat"
+ s1 (parse (lex-basic/token "goal" "gol" "gal" "moat") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "token - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected goat\nunexpected goa\nexpecting goal, gol, gal or moat" em)))))
+
+
+(deftest test-0105
+ (let [in "program \t\t foo()"
+ s1 (parse (lex-basic/word "program") in)]
+ (testing "word - parses a specific, delimited word"
+ (is (= [\f \o \o \( \)] (:input s1)))
+ (is (= "program" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0110
+ (let [in "else{}"
+ s1 (parse (lex-basic/word "else") in)]
+ (testing "word - parses a specific, delimited word"
+ (is (= [\{ \}] (:input s1)))
+ (is (= "else" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0115
+ (let [in "procedure"
+ s1 (parse (lex-basic/word "proc") in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word - fails because is not delimited"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected e\nexpecting end of proc" em)))))
+
+
+(deftest test-0120
+ (let [in "foobar()"
+ s1 (parse lex-basic/identifier in)]
+ (testing "identifier - parses a basic identifier"
+ (is (= [\( \)] (:input s1)))
+ (is (= "foobar" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0125
+ (let [in "total_45 := 0;"
+ s1 (parse lex-basic/identifier in)]
+ (testing "identifier - parses a basic identifier"
+ (is (= [\: \= \space \0 \;] (:input s1)))
+ (is (= "total_45" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0130
+ (let [in "4privateUse"
+ s1 (parse lex-basic/identifier in)
+ em (k/get-msg-str (:error s1))]
+ (testing "identifier - fails with invalid starting char"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\4\nexpecting letter or \\_"
+ :cljs "unexpected \"4\"\nexpecting letter or \"_\"")
+ em)))))
+
+
+(deftest test-0135
+ (let [in "'a' \t\t|;"
+ s1 (parse lex-basic/char-lit in)]
+ (testing "char-lit - parses a character literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= \a (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0140
+ (let [in "'\\n' \t\t|;"
+ s1 (parse lex-basic/char-lit in)]
+ (testing "char-lit - parses an escaped character literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+
+(deftest test-0145
+ (let [in "'\\t' \t\t|;"
+ s1 (parse lex-basic/char-lit in)]
+ (testing "char-lit - parses an escaped character literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0150
+ (let [in "'u2"
+ s1 (parse lex-basic/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails with a missing closing quote"
+ (is (= [\2] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\2\nexpecting end of character literal"
+ :cljs "unexpected \"2\"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0155
+ (let [in "u2"
+ s1 (parse lex-basic/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\u\nexpecting character literal"
+ :cljs "unexpected \"u\"\nexpecting character literal")
+ em)))))
+
+
+(deftest test-0160
+ (let [in "\"now is the time\" \t\t|;"
+ s1 (parse lex-basic/string-lit in)]
+ (testing "string-lit - parses a simple string literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= "now is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0165
+ (let [in "\"now\\nis\\tthe\\ttime\" \t\t|;"
+ s1 (parse lex-basic/string-lit in)]
+ (testing "string-lit - parses a string with escaped chars"
+ (is (= [\| \;] (:input s1)))
+ (is (= "now\nis\tthe\ttime" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0170
+ (let [in "\"now is the time"
+ s1 (parse lex-basic/string-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "string-lit - fails with a string that is not terminated"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected end of input\nexpecting end of string literal" em)))))
+
+
+(deftest test-0175
+ (let [in "45 + foobar"
+ s1 (parse lex-basic/string-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "string-lit - fails; not a string"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\4\nexpecting string literal"
+ :cljs "unexpected \"4\"\nexpecting string literal") em)))))
+
+
+(deftest test-0180
+ (let [in "+100"
+ s1 (parse lex-basic/dec-lit in)]
+ (testing "dec-lit - parses a redundant positive sign"
+ (is (empty? (:input s1)))
+ (is (= 100 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0185
+ (let [in "123456789"
+ s1 (parse lex-basic/dec-lit in)]
+ (testing "dec-lit - parses an integer"
+ (is (empty? (:input s1)))
+ (is (= 123456789 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0190
+ (let [in "1000000000N"
+ s1 (parse lex-basic/dec-lit in)]
+ (testing "dec-lit - parses a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 1000000000N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0195
+ (let [in "-747"
+ s1 (parse lex-basic/dec-lit in)]
+ (testing "dec-lit - parses a negative int"
+ (is (empty? (:input s1)))
+ (is (= -747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0200
+ (let [in "9999999999999999999"
+ s1 (parse lex-basic/dec-lit in)
+ c1 (get-class s1)]
+ (testing "dec-lit - promotes a decimal to a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 9999999999999999999N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (= c1 #?(:clj "class clojure.lang.BigInt" :cljs "function Number() { [native code] }"))))))
+
+(deftest test-0205
+ (let [in "100NA"
+ s1 (parse lex-basic/dec-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "dec-lit - fails; no letter can follow N"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected A\nexpecting decimal literal" em)))))
+
+
+(deftest test-0210
+ (let [in "100e"
+ s1 (parse lex-basic/dec-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "dec-lit - fails; no letter can follow the last digit"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected e\nexpecting decimal literal" em)))))
+
+
+(deftest test-0215
+ (let [in "99."
+ s1 (parse lex-basic/dec-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "dec-lit - fails; the last digit can't be followed by a dot"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected .\nexpecting decimal literal" em)))))
+
+
+(deftest test-0220
+ (let [in "0"
+ s1 (parse lex-basic/oct-lit in)]
+ (testing "oct-lit - zero should be a valid octal number"
+ (is (empty? (:input s1)))
+ (is (= 0 (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1)))))
+
+
+(deftest test-0225
+ (let [in "+0100"
+ s1 (parse lex-basic/oct-lit in)]
+ (testing "oct-lit - parses a redundant positive sign"
+ (is (empty? (:input s1)))
+ (is (= 64 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0230
+ (let [in "012345676543210"
+ s1 (parse lex-basic/oct-lit in)]
+ (testing "oct-lit - parses an integer"
+ (is (empty? (:input s1)))
+ (is (= 012345676543210 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0235
+ (let [in "03777N"
+ s1 (parse lex-basic/oct-lit in)]
+ (testing "oct-lit - parses a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 03777N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0240
+ (let [in "-0747"
+ s1 (parse lex-basic/oct-lit in)]
+ (testing "oct-lit - parses a negative int"
+ (is (empty? (:input s1)))
+ (is (= -0747 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0245
+ (let [in "055555555555555555555N"
+ s1 (parse lex-basic/oct-lit in)
+ c1 (get-class s1)]
+ (testing "oct-lit - promotes a decimal to a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 055555555555555555555N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (= c1 #?(:clj "class clojure.lang.BigInt" :cljs "function Number() { [native code] }"))))))
+
+(deftest test-0250
+ (let [in "0100NA"
+ s1 (parse lex-basic/oct-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "oct-lit - fails; no letter can follow N"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected A\nexpecting octal literal" em)))))
+
+
+(deftest test-0255
+ (let [in "0100e"
+ s1 (parse lex-basic/oct-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "oct-lit - fails; no letter can follow the last digit"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected e\nexpecting octal literal" em)))))
+
+
+(deftest test-0260
+ (let [in "077."
+ s1 (parse lex-basic/oct-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "oct-lit - fails; the last digit can't be followed by a dot"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected .\nexpecting octal literal" em)))))
+
+
+(deftest test-0265
+ (let [in "0x0"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - parses a zero"
+ (is (empty? (:input s1)))
+ (is (= 0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0270
+ (let [in "0XABCDEF"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - uses all capial letters"
+ (is (empty? (:input s1)))
+ (is (= 0xabcdef (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0275
+ (let [in "0xabcdef"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - uses all capial letters"
+ (is (empty? (:input s1)))
+ (is (= 0XABCDEF (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0280
+ (let [in "+0x100"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - parses a redundant positive sign"
+ (is (empty? (:input s1)))
+ (is (= 0x100 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0285
+ (let [in "0xCAFEBABE"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - parses an integer"
+ (is (empty? (:input s1)))
+ (is (= 0xCAFEBABE (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0290
+ (let [in "0x00008B55CABA0000N"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - parses a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 0x00008B55CABA0000N (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0295
+ (let [in "-0x0F0E"
+ s1 (parse lex-basic/hex-lit in)]
+ (testing "hex-lit - parses a negative int"
+ (is (empty? (:input s1)))
+ (is (= -0x0F0E (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0300
+ (let [in "0x8000FA7770000B3400400200A"
+ s1 (parse lex-basic/hex-lit in)
+ c1 (get-class s1)]
+ (testing "hex-lit - promotes a decimal to a BigInt"
+ (is (empty? (:input s1)))
+ (is (= 0x8000FA7770000B3400400200AN (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (= c1 #?(:clj "class clojure.lang.BigInt" :cljs "function Number() { [native code] }"))))))
+
+(deftest test-0305
+ (let [in "0x100NA"
+ s1 (parse lex-basic/hex-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "hex-lit - fails; no letter can follow N"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected A\nexpecting hex literal" em)))))
+
+
+(deftest test-0310
+ (let [in "0x100x"
+ s1 (parse lex-basic/hex-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "hex-lit - fails; no letter can follow the last digit"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected x\nexpecting hex literal" em)))))
+
+
+(deftest test-0315
+ (let [in "0x77."
+ s1 (parse lex-basic/hex-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "hex-lit - fails; the last digit can't be followed by a dot"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected .\nexpecting hex literal" em)))))
+
+
+(deftest test-0320
+ (let [in "0"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a zero"
+ (is (empty? (:input s1)))
+ (is (= 0.0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0325
+ (let [in "0.0"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a zero"
+ (is (empty? (:input s1)))
+ (is (= 0.0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0330
+ (let [in "+100.00"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a redundant positive sign"
+ (is (empty? (:input s1)))
+ (is (= 100.00 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0335
+ (let [in "1558.95"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a floating-point number"
+ (is (empty? (:input s1)))
+ (is (= 1558.95 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0340
+ (let [in "1558.955e12"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a floating-point number with an exponent"
+ (is (empty? (:input s1)))
+ (is (= 1558.955e12 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0345
+ (let [in "1558.9558e-12"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a floating-point number with an exponent"
+ (is (empty? (:input s1)))
+ (is (= 1558.9558e-12 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0350
+ (let [in "1558.9558e+12"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a floating-point number with an exponent"
+ (is (empty? (:input s1)))
+ (is (= 1558.9558e+12 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0355
+ (let [in "-1558.9558e-12"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a negative floating-point number with an exponent"
+ (is (empty? (:input s1)))
+ (is (= -1558.9558e-12 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0360
+ (let [in "1558e12"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a number with no fractional part and an exponent"
+ (is (empty? (:input s1)))
+ (is (= 1558e12 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0365
+ (let [in "3.1415927M"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a BigDecimal"
+ (is (empty? (:input s1)))
+ (is (= 3.1415927M (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0370
+ (let [in "-199.95"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a negative floating-point number"
+ (is (empty? (:input s1)))
+ (is (= -199.95 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0370-05
+ (let [in "999"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - parses a round integer as a floating-point number"
+ (is (empty? (:input s1)))
+ (is (= 999.0 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0370-10
+ (let [in "999"
+ s1 (parse lex-basic/float-lit in)]
+ (testing "float-lit - regression test: number should not be long"
+ (not (= 999 (:value s1))))))
+
+
+(deftest test-0375
+ (let [in "99.95MA"
+ s1 (parse lex-basic/float-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "float-lit - fails; no letter can follow M"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected A\nexpecting floating-point literal" em)))))
+
+
+(deftest test-0380
+ (let [in "99.95X"
+ s1 (parse lex-basic/float-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "float-lit - fails; no letter can follow the last digit"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "unexpected X\nexpecting floating-point literal" em)))))
+
+
+(deftest test-0385
+ (let [in ".9999"
+ s1 (parse lex-basic/float-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "float-lit - fails; cannot start with a dot"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\.\nexpecting floating-point literal"
+ :cljs "unexpected \".\"\nexpecting floating-point literal")
+ em)))))
+
+
+(deftest test-0390
+ (let [in "true"
+ s1 (parse lex-basic/bool-lit in)]
+ (testing "bool-lit - true"
+ (is (empty? (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0395
+ (let [in "false"
+ s1 (parse lex-basic/bool-lit in)]
+ (testing "bool-lit - false"
+ (is (empty? (:input s1)))
+ (is (false? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0400
+ (let [in "true \t \t)"
+ s1 (parse lex-basic/bool-lit in)]
+ (testing "bool-lit - true with whitespace"
+ (is (= [\)] (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0405
+ (let [in "false\n\t\t :"
+ s1 (parse lex-basic/bool-lit in)]
+ (testing "bool-lit - false with whitespace"
+ (is (= [\:] (:input s1)))
+ (is (false? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0410
+ (let [in "nil"
+ s1 (parse lex-basic/nil-lit in)]
+ (testing "nil-lit - nil"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0415
+ (let [in "null"
+ s1 (parse lex-basic/nil-lit in)]
+ (testing "nil-lit - null"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0420
+ (let [in "nil \t \t)"
+ s1 (parse lex-basic/nil-lit in)]
+ (testing "nil-lit - nil with whitespace"
+ (is (= [\)] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0425
+ (let [in "null\n\t\t :"
+ s1 (parse lex-basic/nil-lit in)]
+ (testing "nil-lit - null with whitespace"
+ (is (= [\:] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0430
+ (let [in "(true)"
+ s1 (parse (lex-basic/parens lex-basic/bool-lit) in)]
+ (testing "parens - true"
+ (is (empty? (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0435
+ (let [in "()"
+ s1 (parse (lex-basic/parens (k/many lex-basic/dec-lit)) in)]
+ (testing "parens - nothing"
+ (is (empty? (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0440
+ (let [in "( 11 22 33 44 55 )"
+ s1 (parse (lex-basic/parens (k/many1 lex-basic/dec-lit)) in)]
+ (testing "parens - true"
+ (is (empty? (:input s1)))
+ (is (= [11 22 33 44 55] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0445
+ (let [in "11 22 33)"
+ s1 (parse (lex-basic/parens (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "parens - fails; no starting paren"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\1\nexpecting \\("
+ :cljs "unexpected \"1\"\nexpecting \"(\"")
+ em)))))
+
+
+(deftest test-0450
+ (let [in "(11 22 33 ;"
+ s1 (parse (lex-basic/parens (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "parens - fails; no ending paren"
+ (is (= [\;] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\;\nexpecting \\)"
+ :cljs "unexpected \";\"\nexpecting \")\"")
+ em)))))
+
+
+(deftest test-0455
+ (let [in "()"
+ s1 (parse (lex-basic/parens lex-basic/dec-lit) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "parens - fails; missing value"
+ (is (= [\)] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\)\nexpecting decimal literal"
+ :cljs "unexpected \")\"\nexpecting decimal literal")
+ em)))))
+
+
+(deftest test-0460
+ (let [in "{true}"
+ s1 (parse (lex-basic/braces lex-basic/bool-lit) in)]
+ (testing "braces - true"
+ (is (empty? (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0465
+ (let [in "{}"
+ s1 (parse (lex-basic/braces (k/many lex-basic/dec-lit)) in)]
+ (testing "braces - nothing"
+ (is (empty? (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0470
+ (let [in "{ 11 22 33 44 55 }"
+ s1 (parse (lex-basic/braces (k/many1 lex-basic/dec-lit)) in)]
+ (testing "braces - true"
+ (is (empty? (:input s1)))
+ (is (= [11 22 33 44 55] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0475
+ (let [in "11 22 33}"
+ s1 (parse (lex-basic/braces (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "braces - fails; no starting brace"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\1\nexpecting \\{"
+ :cljs "unexpected \"1\"\nexpecting \"{\"")
+ em)))))
+
+
+(deftest test-0480
+ (let [in "{11 22 33 ;"
+ s1 (parse (lex-basic/braces (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "braces - fails; no ending brace"
+ (is (= [\;] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\;\nexpecting \\}"
+ :cljs "unexpected \";\"\nexpecting \"}\"")
+ em)))))
+
+
+(deftest test-0485
+ (let [in "{}"
+ s1 (parse (lex-basic/braces lex-basic/dec-lit) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "braces - fails; missing value"
+ (is (= [\}] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\}\nexpecting decimal literal"
+ :cljs "unexpected \"}\"\nexpecting decimal literal")
+ em)))))
+
+
+(deftest test-0490
+ (let [in ""
+ s1 (parse (lex-basic/angles lex-basic/bool-lit) in)]
+ (testing "angles - true"
+ (is (empty? (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0495
+ (let [in "<>"
+ s1 (parse (lex-basic/angles (k/many lex-basic/dec-lit)) in)]
+ (testing "angles - nothing"
+ (is (empty? (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0500
+ (let [in "< 11 22 33 44 55 >"
+ s1 (parse (lex-basic/angles (k/many1 lex-basic/dec-lit)) in)]
+ (testing "angles - true"
+ (is (empty? (:input s1)))
+ (is (= [11 22 33 44 55] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0505
+ (let [in "11 22 33>"
+ s1 (parse (lex-basic/angles (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "angles - fails; no starting angle bracket"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\1\nexpecting \\<"
+ :cljs "unexpected \"1\"\nexpecting \"<\"")
+ em)))))
+
+
+(deftest test-0510
+ (let [in "<11 22 33 ;"
+ s1 (parse (lex-basic/angles (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "angles - fails; no ending angle bracket"
+ (is (= [\;] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\;\nexpecting \\>"
+ :cljs "unexpected \";\"\nexpecting \">\"")
+ em)))))
+
+
+(deftest test-0515
+ (let [in "<>"
+ s1 (parse (lex-basic/angles lex-basic/dec-lit) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "angles - fails; missing value"
+ (is (= [\>] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\>\nexpecting decimal literal"
+ :cljs "unexpected \">\"\nexpecting decimal literal")
+ em)))))
+
+
+(deftest test-0520
+ (let [in "[true]"
+ s1 (parse (lex-basic/brackets lex-basic/bool-lit) in)]
+ (testing "brackets - true"
+ (is (empty? (:input s1)))
+ (is (:value s1))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0525
+ (let [in "[]"
+ s1 (parse (lex-basic/brackets (k/many lex-basic/dec-lit)) in)]
+ (testing "brackets - nothing"
+ (is (empty? (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0530
+ (let [in "[ 11 22 33 44 55 ]"
+ s1 (parse (lex-basic/brackets (k/many1 lex-basic/dec-lit)) in)]
+ (testing "brackets - true"
+ (is (empty? (:input s1)))
+ (is (= [11 22 33 44 55] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0535
+ (let [in "11 22 33]"
+ s1 (parse (lex-basic/brackets (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "brackets - fails; no starting bracket"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\1\nexpecting \\["
+ :cljs "unexpected \"1\"\nexpecting \"[\"")
+ em)))))
+
+
+(deftest test-0540
+ (let [in "[11 22 33 ;"
+ s1 (parse (lex-basic/brackets (k/many1 lex-basic/dec-lit)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "brackets - fails; no ending bracket"
+ (is (= [\;] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\;\nexpecting \\]"
+ :cljs "unexpected \";\"\nexpecting \"]\"")
+ em)))))
+
+
+(deftest test-0545
+ (let [in "[]"
+ s1 (parse (lex-basic/brackets lex-basic/dec-lit) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "brackets - fails; missing value"
+ (is (= [\]] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\]\nexpecting decimal literal"
+ :cljs "unexpected \"]\"\nexpecting decimal literal")
+ em)))))
+
+
+(deftest test-0550
+ (let [in ";\n\n"
+ s1 (parse lex-basic/semi in)]
+ (testing "semi"
+ (is (empty? (:input s1)))
+ (is (= \; (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0555
+ (let [in "+"
+ s1 (parse lex-basic/semi in)
+ em (k/get-msg-str (:error s1))]
+ (testing "semi - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\+\nexpecting \\;"
+ :cljs "unexpected \"+\"\nexpecting \";\"")
+ em)))))
+
+
+(deftest test-0560
+ (let [in ",\n\n"
+ s1 (parse lex-basic/comma in)]
+ (testing "comma"
+ (is (empty? (:input s1)))
+ (is (= \, (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0565
+ (let [in "+"
+ s1 (parse lex-basic/comma in)
+ em (k/get-msg-str (:error s1))]
+ (testing "comma - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\+\nexpecting \\,"
+ :cljs "unexpected \"+\"\nexpecting \",\"")
+ em)))))
+
+
+(deftest test-0570
+ (let [in ":\n\n"
+ s1 (parse lex-basic/colon in)]
+ (testing "colon"
+ (is (empty? (:input s1)))
+ (is (= \: (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0575
+ (let [in "+"
+ s1 (parse lex-basic/colon in)
+ em (k/get-msg-str (:error s1))]
+ (testing "colon - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\+\nexpecting \\:"
+ :cljs "unexpected \"+\"\nexpecting \":\"")
+ em)))))
+
+
+(deftest test-0580
+ (let [in ".\n\n"
+ s1 (parse lex-basic/dot in)]
+ (testing "comma"
+ (is (empty? (:input s1)))
+ (is (= \. (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0585
+ (let [in "+"
+ s1 (parse lex-basic/dot in)
+ em (k/get-msg-str (:error s1))]
+ (testing "dot - fails"
+ (is (= (seq in) (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\+\nexpecting \\."
+ :cljs "unexpected \"+\"\nexpecting \".\"")
+ em)))))
+
+
+(deftest test-0590
+ (let [s1 (parse (lex-basic/semi-sep k/digit) "*")]
+ (testing "semi-sep - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0595
+ (let [s1 (parse (lex-basic/semi-sep (>> k/letter k/digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0600
+ (let [s1 (parse (lex-basic/semi-sep k/digit) "0*")]
+ (testing "semi-sep - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0605
+ (let [s1 (parse (lex-basic/semi-sep (<*> k/upper k/digit)) "U2*")]
+ (testing "semi-sep - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0610
+ (let [s1 (parse (lex-basic/semi-sep (>> k/letter k/digit)) "U2;*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter"
+ :cljs "unexpected \"*\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0615
+ (let [s1 (parse (lex-basic/semi-sep lex-basic/dec-lit) "550; 101*")]
+ (testing "semi-sep - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [550 101] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0620
+ (let [s1 (parse (lex-basic/semi-sep lex-basic/hex-lit) "+0xFADE ; -0x7800 *")]
+ (testing "semi-sep - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [0xFADE -0x7800] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0625
+ (let [p1 (lex-basic/semi-sep lex-basic/identifier)
+ s1 (parse p1 "one ;\n two ; \t\t three")]
+ (testing "semi-sep - three compound items"
+ (is (empty? (:input s1)))
+ (is (= ["one" "two" "three"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0630
+ (let [s1 (parse (lex-basic/semi-sep1 k/digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep1 - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0635
+ (let [s1 (parse (lex-basic/semi-sep1 (>> k/letter k/digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep1 - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0640
+ (let [s1 (parse (lex-basic/semi-sep1 lex-basic/dec-lit) "747*")]
+ (testing "semi-sep1 - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [747] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0645
+ (let [s1 (parse (lex-basic/semi-sep1 (<*> k/upper k/digit)) "U2*")]
+ (testing "semi-sep1 - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0650
+ (let [s1 (parse (lex-basic/semi-sep1 lex-basic/identifier) "U2;*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep1 - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter or \\_"
+ :cljs "unexpected \"*\"\nexpecting letter or \"_\"")
+ em)))))
+
+
+(deftest test-0655
+ (let [s1 (parse (lex-basic/semi-sep1 lex-basic/dec-lit) "100;200*")]
+ (testing "semi-sep1 - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [100 200] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0660
+ (let [s1 (parse (lex-basic/semi-sep1 lex-basic/dec-lit) "-100 \t \t;\n +200*")]
+ (testing "semi-sep1 - two compound items with whitespace"
+ (is (= [\*] (:input s1)))
+ (is (= [-100 200] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0665
+ (let [p1 (lex-basic/semi-sep1 lex-basic/identifier)
+ s1 (parse p1 "one ;\n\n two \t\t;\n\t three")]
+ (testing "semi-sep1 - three compound items"
+ (is (empty? (:input s1)))
+ (is (= ["one" "two" "three"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0670
+ (let [s1 (parse (lex-basic/semi-sep1 (>> k/upper k/digit)) "A1; B2; \tC3;DD;*")
+ em (k/get-msg-str (:error s1))]
+ (testing "semi-sep1 - compound item fails after reading several items"
+ (is (= [\D \; \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\D\nexpecting digit"
+ :cljs "unexpected \"D\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0675
+ (let [s1 (parse (lex-basic/comma-sep k/digit) "*")]
+ (testing "comma-sep - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (:empty s1))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0680
+ (let [s1 (parse (lex-basic/comma-sep (>> k/letter k/digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0685
+ (let [s1 (parse (lex-basic/comma-sep k/digit) "0*")]
+ (testing "comma-sep - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [\0] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0690
+ (let [s1 (parse (lex-basic/comma-sep (<*> k/upper k/digit)) "U2*")]
+ (testing "comma-sep - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0695
+ (let [s1 (parse (lex-basic/comma-sep (>> k/letter k/digit)) "U2,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter"
+ :cljs "unexpected \"*\"\nexpecting letter")
+ em)))))
+
+
+(deftest test-0700
+ (let [s1 (parse (lex-basic/comma-sep lex-basic/dec-lit) "550, 101*")]
+ (testing "comma-sep - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [550 101] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0705
+ (let [s1 (parse (lex-basic/comma-sep lex-basic/hex-lit) "+0xFADE , -0x7800 *")]
+ (testing "comma-sep - two compound items"
+ (is (= [\*] (:input s1)))
+ (is (= [0xFADE -0x7800] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0710
+ (let [p1 (lex-basic/comma-sep lex-basic/identifier)
+ s1 (parse p1 "one ,\n two , \t\t three")]
+ (testing "comma-sep - three compound items"
+ (is (empty? (:input s1)))
+ (is (= ["one" "two" "three"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0715
+ (let [s1 (parse (lex-basic/comma-sep1 k/digit) "*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep1 - there are no separated items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0720
+ (let [s1 (parse (lex-basic/comma-sep1 (>> k/letter k/digit)) "A*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep1 - there are no separated compound items"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting digit"
+ :cljs "unexpected \"*\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0725
+ (let [s1 (parse (lex-basic/comma-sep1 lex-basic/dec-lit) "747*")]
+ (testing "comma-sep1 - one item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [747] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0730
+ (let [s1 (parse (lex-basic/comma-sep1 (<*> k/upper k/digit)) "U2*")]
+ (testing "comma-sep1 - one compound item, no separator"
+ (is (= [\*] (:input s1)))
+ (is (= [[\U \2]] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0735
+ (let [s1 (parse (lex-basic/comma-sep1 lex-basic/identifier) "U2,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep1 - there is only one item and the separator"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting letter or \\_"
+ :cljs "unexpected \"*\"\nexpecting letter or \"_\"")
+ em)))))
+
+
+(deftest test-0740
+ (let [s1 (parse (lex-basic/comma-sep1 lex-basic/dec-lit) "100,200*")]
+ (testing "comma-sep1 - two simple items"
+ (is (= [\*] (:input s1)))
+ (is (= [100 200] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0745
+ (let [s1 (parse (lex-basic/comma-sep1 lex-basic/dec-lit) "-100 \t \t,\n +200*")]
+ (testing "comma-sep1 - two compound items with whitespace"
+ (is (= [\*] (:input s1)))
+ (is (= [-100 200] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0750
+ (let [p1 (lex-basic/comma-sep1 lex-basic/identifier)
+ s1 (k/parse p1 "one ,\n\n two \t\t,\n\t three")]
+ (testing "comma-sep1 - three compound items"
+ (is (empty? (:input s1)))
+ (is (= ["one" "two" "three"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0755
+ (let [s1 (parse (lex-basic/comma-sep1 (>> k/upper k/digit)) "A1, B2, \tC3,DD,*")
+ em (k/get-msg-str (:error s1))]
+ (testing "comma-sep1 - compound item fails after reading several items"
+ (is (= [\D \, \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\D\nexpecting digit"
+ :cljs "unexpected \"D\"\nexpecting digit")
+ em)))))
+
+
+(deftest test-0760
+ (let [s1 (parse lex-basic/char-lit "'z'")]
+ (testing "char-lit"
+ (is (= \z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0765
+ (let [s1 (parse lex-basic/char-lit "'\\b'")]
+ (testing "char-lit"
+ (is (= \backspace (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0770
+ (let [s1 (parse lex-basic/char-lit "'\\t'")]
+ (testing "char-lit"
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0775
+ (let [s1 (parse lex-basic/char-lit "'\\n'")]
+ (testing "char-lit"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0780
+ (let [s1 (parse lex-basic/char-lit "'\\f'")]
+ (testing "char-lit"
+ (is (= \formfeed (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0785
+ (let [s1 (parse lex-basic/char-lit "'\\r'")]
+ (testing "char-lit"
+ (is (= \return (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0790
+ (let [s1 (parse lex-basic/char-lit "'\\''")]
+ (testing "char-lit"
+ (is (= \' (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0795
+ (let [s1 (parse lex-basic/char-lit "'\\\"'")]
+ (testing "char-lit"
+ (is (= \" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0800
+ (let [s1 (parse lex-basic/char-lit "'\\\\'")]
+ (testing "char-lit"
+ (is (= \\ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0805
+ (let [s1 (parse lex-basic/char-lit "'\\/'")]
+ (testing "char-lit"
+ (is (= \/ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+(deftest test-0810
+ (let [in "'a "
+ s1 (parse lex-basic/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails without the closing quote"
+ (is (= [\space] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\space\nexpecting end of character literal"
+ :cljs "unexpected \" \"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0815
+ (let [in "'\\n "
+ s1 (parse lex-basic/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails without the closing quote"
+ (is (= [\space] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\space\nexpecting end of character literal"
+ :cljs "unexpected \" \"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0820
+ (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
+ s1 (parse lex-basic/string-lit in)]
+ (testing "string-lit - parses a string with multiple escaped characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "\bnow\tis\nthe\ftime\r" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+;; +-------------------------------------------------------------+
+;; | Custom lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0820-05
+ (let [rec (lex/make-parsers (assoc lex/shell-style-def :line-continuation (k/sym* \?)))]
+ (lex/with-parsers rec
+ (let [in "foo bar foobar ?\n\t\tbaz"
+ s1 (parse (k/many1 lex/identifier) in)]
+ (testing "trim - line continuation with a ?"
+ (is (empty? (:input s1)))
+ (is (= ["foo" "bar" "foobar" "baz"] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0825
+ (let [rec (lex/make-parsers (assoc lex/c-style-def :case-sensitive false))]
+ (lex/with-parsers rec
+ (let [in "WhIlE (..."
+ s1 (parse (lex/word "while") in)]
+ (testing "word - non-case-sensitive"
+ (is (= [\( \. \. \.] (:input s1)))
+ (is (= "while" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0830
+ (let [rec (lex/make-parsers (assoc lex/c-style-def :nested-comments true))]
+ (lex/with-parsers rec
+ (let [in "foo /***outter /* inner comment */ end of outer***/"
+ s1 (parse lex/identifier in)]
+ (testing "word - nested comments"
+ (is (empty? (:input s1)))
+ (is (= "foo" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0845
+ (let [rec (lex/make-parsers (assoc lex/c-style-def :reserved-names ["foo" "bar"]))]
+ (lex/with-parsers rec
+ (let [in "foobar * baz"
+ s1 (parse lex/identifier in)]
+ (testing "word - valid word, not a reserved word"
+ (is (= "foobar" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\* \space \b \a \z] (:input s1)))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0850
+ (let [rec (lex/make-parsers (assoc lex/c-style-def :reserved-names ["foo" "bar"]))]
+ (lex/with-parsers rec
+ (let [in "foo * bar"
+ s1 (parse lex/identifier in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word - fails on a reserved word"
+ (is (= [\f \o \o \space \* \space \b \a \r] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "foo is a reserved name" em)))))))
+
+
+(deftest test-0855
+ (let [rec (lex/make-parsers (assoc lex/c-style-def
+ :case-sensitive false
+ :reserved-names ["foo" "bar"]))]
+ (lex/with-parsers rec
+ (let [in "FOO * bar"
+ s1 (parse lex/identifier in)
+ em (k/get-msg-str (:error s1))]
+ (testing "word - fails on a reserved word"
+ (is (= [\F \O \O \space \* \space \b \a \r] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= "FOO is a reserved name" em)))))))
+
+
+(deftest test-0860
+ (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
+ (lex/with-parsers rec
+ (let [in "5005"
+ s1 (parse lex/dec-lit in)]
+ (testing "dec-lit - regular case, no leading sign."
+ (is (empty? (:input s1)))
+ (is (= 5005 (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0865
+ (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
+ (lex/with-parsers rec
+ (let [in "0xCAFE"
+ s1 (parse lex/hex-lit in)]
+ (testing "hex-lit - regular case, no leading sign."
+ (is (empty? (:input s1)))
+ (is (= 0xCAFE (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))))
+
+
+(deftest test-0870
+ (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
+ (lex/with-parsers rec
+ (let [in "-5005"
+ s1 (parse lex/dec-lit in)]
+ (testing "dec-lit - with leading sign it fails."
+ (is (= (seq "-5005") (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1))))))))
+
+
+(deftest test-0875
+ (let [rec (lex/make-parsers (assoc lex/basic-def :leading-sign false))]
+ (lex/with-parsers rec
+ (let [in "+3.1416"
+ s1 (parse lex/float-lit in)]
+ (testing "float-lit - with leading sign it fails."
+ (is (= (seq "+3.1416") (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1))))))))
+
+
+;; +-------------------------------------------------------------+
+;; | Repeating Patterns. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0900
+ (let [s1 (parse lex-basic/identifier "f")]
+ (testing "identifier -- state must not be empty"
+ (is (= "f" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0905
+ (let [s1 (parse (k/many lex-basic/identifier) "f")]
+ (testing "identifier -- many should work with a single-letter id"
+ (is (= ["f"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0910
+ (let [s1 (parse (lex-basic/comma-sep lex-basic/identifier) "f")]
+ (testing "multiple identifier"
+ (is (= ["f"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0915
+ (let [s1 (parse (k/many (lex-basic/sym \Q)) "QQQ")]
+ (testing "multiple symbols"
+ (is (= [\Q \Q \Q] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0920
+ (let [s1 (parse (k/many (lex-basic/one-of "abc")) "a b c")]
+ (testing "many one-of"
+ (is (= [\a \b \c] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0925
+ (let [s1 (parse (k/many (lex-basic/none-of "abc")) "xyz")]
+ (testing "many none-of"
+ (is (= [\x \y \z] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0930
+ (let [s1 (parse (k/many (lex-basic/token "abc")) "abcabc abc")]
+ (testing "many token"
+ (is (= ["abc" "abc" "abc"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0935
+ (let [s1 (parse (k/many0 (lex-basic/token "abc")) "xxx")]
+ (testing "many0, nothing match but empty is cleared"
+ (is (= [] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= (seq "xxx") (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0940
+ (let [s1 (parse (k/many (lex-basic/field " ")) "now is the time")]
+ (testing "many field"
+ (is (= ["now" "is" "the" "time"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0945
+ (let [s1 (parse (k/many (lex-basic/field " ")) "x y")]
+ (testing "many token"
+ (is (= ["x" "y"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0950
+ (let [s1 (parse (k/many lex-basic/dec-lit) "0")]
+ (testing "many dec-lit"
+ (is (= [0] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0955
+ (let [s1 (parse (k/many lex-basic/oct-lit) "01")]
+ (testing "many oct-lit"
+ (is (= [1] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0960
+ (let [s1 (parse (k/many lex-basic/hex-lit) "0x1")]
+ (testing "many hex-lit"
+ (is (= [1] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0965
+ (let [s1 (parse (k/many lex-basic/float-lit) "1")]
+ (testing "many float-lit"
+ (is (= [1.0] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
diff --git a/src/test/clojure/blancas/kern/test_lexer_c.clj b/src/test/clojure/blancas/kern/test_lexer_c.clj
deleted file mode 100644
index f8fcf0e..0000000
--- a/src/test/clojure/blancas/kern/test_lexer_c.clj
+++ /dev/null
@@ -1,423 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-lexer-c
- (:use [blancas.kern.core]
- [blancas.kern.lexer.c-style]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)]))
-
-;; Private functions from kern.core
-
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-
-
-;; +-------------------------------------------------------------+
-;; | Java-style lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse (>> trim eof) " \t\t\n")]
- (fact "trim - blank, tab, eol, then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0005
- (let [s1 (parse (>> trim (many digit)) "123")]
- (fact "trim - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0010
- (let [s1 (parse (>> trim (many1 letter)) " /* comment */ \t\n\t\t ABC")]
- (fact "trim - whitespace before letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0015
- (let [s1 (parse (>> (lexeme (sym* \space)) eof) " \t\t\n")]
- (fact "lexeme - a blank, then tab, eol; then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0020
- (let [s1 (parse (lexeme (many digit)) "123")]
- (fact "lexeme - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0025
- (let [s1 (parse (lexeme (many1 letter)) "ABC /* that's it */ \t\n\t\t")]
- (fact "lexeme - whitespace and comments after letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0030
- (let [s1 (parse (lexeme (many1 letter)) "foo // and the rest is history\nbar")]
- (fact "trim - single-line comment"
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\b \a \r]
- (:empty s1) => false)))
-
-
-(deftest test-0035
- (let [in "foo // variable\n// that's all\n// for now\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple single-line comments"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0040
- (let [in "foo /* var foo\n that's all\n for now */\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0045
- (let [in "foo/********this is a comment**********/"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => empty?
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0050
- (let [in "foo/****** this is a comment*****"
- s1 (parse (lexeme (many1 letter)) in)
- em (get-msg-str (:error s1))]
- (fact "lexeme - fails looking for end of comment"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected end of input\nexpecting end of comment")))
-
-
-(deftest test-0055
- (let [in "foo/******* this is a /* CAN I NEST? */ comment ********/"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - Won't da nested comment; but this works and stops at 'comment'"
- (:input s1) => (seq "comment ********/")
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0060
- (let [s1 (parse char-lit "'z'")]
- (fact "char-lit"
- (:value s1) => \z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0065
- (let [s1 (parse char-lit "'\\b'")]
- (fact "char-lit"
- (:value s1) => \backspace
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0070
- (let [s1 (parse char-lit "'\\t'")]
- (fact "char-lit"
- (:value s1) => \tab
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0075
- (let [s1 (parse char-lit "'\\n'")]
- (fact "char-lit"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0080
- (let [s1 (parse char-lit "'\\f'")]
- (fact "char-lit"
- (:value s1) => \formfeed
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0085
- (let [s1 (parse char-lit "'\\r'")]
- (fact "char-lit"
- (:value s1) => \return
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0090
- (let [s1 (parse char-lit "'\\''")]
- (fact "char-lit"
- (:value s1) => \'
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0095
- (let [s1 (parse char-lit "'\\\"'")]
- (fact "char-lit"
- (:value s1) => \"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0100
- (let [s1 (parse char-lit "'\\\\'")]
- (fact "char-lit"
- (:value s1) => \\
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0105
- (let [s1 (parse char-lit "'\\/'")]
- (fact "char-lit"
- (:value s1) => \/
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0110
- (let [s1 (parse char-lit "'\\u0041'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0115
- (let [s1 (parse char-lit "'\\101'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0120
- (let [in "'a "
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails without the closing quote"
- (:input s1) => [\space]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\space\nexpecting end of character literal")))
-
-
-(deftest test-0125
- (let [in "'\\u2'"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails: incomplete unicode number"
- (:input s1) => [\']
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\'\nexpecting hexadecimal digit")))
-
-
-(deftest test-0130
- (let [in "'\\00*"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails: octal numbers are assumed; that's acually char \0"
- (:input s1) => [\0 \*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\0\nexpecting end of character literal")))
-
-
-(deftest test-0135
- (let [s1 (parse char-lit "'\\?'")]
- (fact "char-lit"
- (:value s1) => \?
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0140
- (let [s1 (parse char-lit "'\\a'")]
- (fact "char-lit"
- (:value s1) => (char 7)
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0145
- (let [s1 (parse char-lit "'\\v'")]
- (fact "char-lit"
- (:value s1) => (char 11)
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0150
- (let [s1 (parse char-lit "'\\0'")]
- (fact "char-lit"
- (:value s1) => (char 0)
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0155
- (let [s1 (parse char-lit "'\\x41'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0160
- (let [s1 (parse char-lit "'\\U00000041'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0165
- (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a simple string literal"
- (:input s1) => [\| \;]
- (:value s1) => "\bnow\tis\nthe\ftime\r"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0170
- (let [in "\"null-terminated\\0\";"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a null-terminated string"
- (:input s1) => [\;]
- (:value s1) => "null-terminated\u0000"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0175
- (let [in "\"\\\\null-terminated\\?\";"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a backslash and a question mark"
- (:input s1) => [\;]
- (:value s1) => "\\null-terminated?"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0180
- (let [in "\"\\tnow is \\u0074\\u0068\\u0065 time\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses unicode characters"
- (:input s1) => [\| \;]
- (:value s1) => "\tnow is the time"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0185
- (let [in "\"now is \\164\\150\\145 time\" /* the */|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses octal characters"
- (:input s1) => [\| \;]
- (:value s1) => "now is the time"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0190
- (let [in "\"now is \\x74\\x68\\x65 time\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses hex characters"
- (:input s1) => [\| \;]
- (:value s1) => "now is the time"
- (:ok s1) => true
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_lexer_c.cljc b/src/test/clojure/blancas/kern/test_lexer_c.cljc
new file mode 100644
index 0000000..1f1674a
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_lexer_c.cljc
@@ -0,0 +1,425 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns blancas.kern.test-lexer-c
+ (:require [blancas.kern.core :as k :refer [parse >>]]
+ [blancas.kern.lexer.c-style :as lex]
+ [clojure.test :refer [deftest is testing]]))
+
+;; +-------------------------------------------------------------+
+;; | Java-style lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse (>> lex/trim k/eof) " \t\t\n")]
+ (testing "trim - blank, tab, eol, then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0005
+ (let [s1 (parse (>> lex/trim (k/many k/digit)) "123")]
+ (testing "trim - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0010
+ (let [s1 (parse (>> lex/trim (k/many1 k/letter)) " /* comment */ \t\n\t\t ABC")]
+ (testing "trim - whitespace before letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0015
+ (let [s1 (parse (>> (lex/lexeme (k/sym* \space)) k/eof) " \t\t\n")]
+ (testing "lexeme - a blank, then tab, eol; then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0020
+ (let [s1 (parse (lex/lexeme (k/many k/digit)) "123")]
+ (testing "lexeme - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0025
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "ABC /* that's it */ \t\n\t\t")]
+ (testing "lexeme - whitespace and comments after letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0030
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "foo // and the rest is history\nbar")]
+ (testing "trim - single-line comment"
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\b \a \r] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0035
+ (let [in "foo // variable\n// that's all\n// for now\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple single-line comments"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0040
+ (let [in "foo /* var foo\n that's all\n for now */\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0045
+ (let [in "foo/********this is a comment**********/"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (empty? (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0050
+ (let [in "foo/****** this is a comment*****"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "lexeme - fails looking for end of comment"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected end of input\nexpecting end of comment"
+ :cljs "unexpected end of input\nexpecting end of comment")
+ em)))))
+
+
+(deftest test-0055
+ (let [in "foo/******* this is a /* CAN I NEST? */ comment ********/"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - Won't da nested comment; but this works and stops at 'comment'"
+ (is (= (seq "comment ********/") (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0060
+ (let [s1 (parse lex/char-lit "'z'")]
+ (testing "char-lit"
+ (is (= \z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0065
+ (let [s1 (parse lex/char-lit "'\\b'")]
+ (testing "char-lit"
+ (is (= \backspace (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0070
+ (let [s1 (parse lex/char-lit "'\\t'")]
+ (testing "char-lit"
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0075
+ (let [s1 (parse lex/char-lit "'\\n'")]
+ (testing "char-lit"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0080
+ (let [s1 (parse lex/char-lit "'\\f'")]
+ (testing "char-lit"
+ (is (= \formfeed (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0085
+ (let [s1 (parse lex/char-lit "'\\r'")]
+ (testing "char-lit"
+ (is (= \return (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0090
+ (let [s1 (parse lex/char-lit "'\\''")]
+ (testing "char-lit"
+ (is (= \' (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0095
+ (let [s1 (parse lex/char-lit "'\\\"'")]
+ (testing "char-lit"
+ (is (= \" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0100
+ (let [s1 (parse lex/char-lit "'\\\\'")]
+ (testing "char-lit"
+ (is (= \\ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0105
+ (let [s1 (parse lex/char-lit "'\\/'")]
+ (testing "char-lit"
+ (is (= \/ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0110
+ (let [s1 (parse lex/char-lit "'\\u0041'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0115
+ (let [s1 (parse lex/char-lit "'\\101'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0120
+ (let [in "'a "
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails without the closing quote"
+ (is (= [\space] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\space\nexpecting end of character literal"
+ :cljs "unexpected \" \"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0125
+ (let [in "'\\u2'"
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails: incomplete unicode number"
+ (is (= [\'] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\'\nexpecting hexadecimal digit"
+ :clsj "unexpected \"'\"\nexpecting hexadecimal digit")
+ em)))))
+
+
+(deftest test-0130
+ (let [in "'\\00*"
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails: octal numbers are assumed; that's acually char \0"
+ (is (= [\0 \*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\0\nexpecting end of character literal"
+ :cljs "unexpected \"0\"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0135
+ (let [s1 (parse lex/char-lit "'\\?'")]
+ (testing "char-lit"
+ (is (= \? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0140
+ (let [s1 (parse lex/char-lit "'\\a'")]
+ (testing "char-lit"
+ (is (= (char 7) (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0145
+ (let [s1 (parse lex/char-lit "'\\v'")]
+ (testing "char-lit"
+ (is (= (char 11) (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0150
+ (let [s1 (parse lex/char-lit "'\\0'")]
+ (testing "char-lit"
+ (is (= (char 0) (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0155
+ (let [s1 (parse lex/char-lit "'\\x41'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0160
+ (let [s1 (parse lex/char-lit "'\\U00000041'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0165
+ (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses a simple string literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= "\bnow\tis\nthe\ftime\r" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0170
+ (let [in "\"null-terminated\\0\";"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses a null-terminated string"
+ (is (= [\;] (:input s1)))
+ (is (= "null-terminated\u0000" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0175
+ (let [in "\"\\\\null-terminated\\?\";"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses a backslash and a question mark"
+ (is (= [\;] (:input s1)))
+ (is (= "\\null-terminated?" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0180
+ (let [in "\"\\tnow is \\u0074\\u0068\\u0065 time\" \t\t|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses unicode characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "\tnow is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0185
+ (let [in "\"now is \\164\\150\\145 time\" /* the */|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses octal characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "now is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0190
+ (let [in "\"now is \\x74\\x68\\x65 time\" \t\t|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses hex characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "now is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
diff --git a/src/test/clojure/blancas/kern/test_lexer_haskell.clj b/src/test/clojure/blancas/kern/test_lexer_haskell.clj
deleted file mode 100644
index 730523c..0000000
--- a/src/test/clojure/blancas/kern/test_lexer_haskell.clj
+++ /dev/null
@@ -1,301 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-lexer-haskell
- (:use [blancas.kern.core]
- [blancas.kern.lexer.haskell-style]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)]))
-
-;; Private functions from kern.core
-
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-
-
-;; +-------------------------------------------------------------+
-;; | Haskell-style lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse (>> trim eof) " \t\t\n")]
- (fact "trim - blank, tab, eol, then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0005
- (let [s1 (parse (>> trim (many digit)) "123")]
- (fact "trim - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0010
- (let [s1 (parse (>> trim (many1 letter)) " {- comment -} \t\n\t\t ABC")]
- (fact "trim - whitespace before letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0015
- (let [s1 (parse (>> (lexeme (sym* \space)) eof) " \t\t\n")]
- (fact "lexeme - a blank, then tab, eol; then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0020
- (let [s1 (parse (lexeme (many digit)) "123")]
- (fact "lexeme - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0025
- (let [s1 (parse (lexeme (many1 letter)) "ABC {- that's it -} \t\n\t\t")]
- (fact "lexeme - whitespace and comments after letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0030
- (let [s1 (parse (lexeme (many1 letter)) "foo -- and the rest is history\nbar")]
- (fact "trim - single-line comment"
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\b \a \r]
- (:empty s1) => false)))
-
-
-(deftest test-0035
- (let [in "foo -- variable\n-- that's all\n-- for now\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple single-line comments"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0040
- (let [in "foo {- var foo\n that's all\n for now -}\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0045
- (let [in "foo{-----this is a comment------}"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => empty?
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0050
- (let [in "foo{-----this is {---- inner comment ----} an outer comment------}"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips nested comments"
- (:input s1) => empty?
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0055
- (let [in "foo{---outer {---- inner {---- most inner ----} less inner ----} outer ----}"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips nested comments"
- (:input s1) => empty?
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0060
- (let [in "foo{-----this is a comment------"
- s1 (parse (lexeme (many1 letter)) in)
- em (get-msg-str (:error s1))]
- (fact "lexeme - fails looking for end of comment"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected end of input\nexpecting end of comment")))
-
-
-(deftest test-0065
- (let [in "foo{-----this is a {- NESTED comment------}"
- s1 (parse (lexeme (many1 letter)) in)
- em (get-msg-str (:error s1))]
- (fact "lexeme - fails looking for end of a nested comment"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected end of input\nexpecting end of comment")))
-
-
-(deftest test-0070
- (let [s1 (parse char-lit "'z'")]
- (fact "char-lit"
- (:value s1) => \z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0075
- (let [s1 (parse char-lit "'\\b'")]
- (fact "char-lit"
- (:value s1) => \backspace
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0080
- (let [s1 (parse char-lit "'\\t'")]
- (fact "char-lit"
- (:value s1) => \tab
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0085
- (let [s1 (parse char-lit "'\\n'")]
- (fact "char-lit"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0090
- (let [s1 (parse char-lit "'\\f'")]
- (fact "char-lit"
- (:value s1) => \formfeed
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0095
- (let [s1 (parse char-lit "'\\r'")]
- (fact "char-lit"
- (:value s1) => \return
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0100
- (let [s1 (parse char-lit "'\\''")]
- (fact "char-lit"
- (:value s1) => \'
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0105
- (let [s1 (parse char-lit "'\\\"'")]
- (fact "char-lit"
- (:value s1) => \"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0110
- (let [s1 (parse char-lit "'\\\\'")]
- (fact "char-lit"
- (:value s1) => \\
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0115
- (let [s1 (parse char-lit "'\\/'")]
- (fact "char-lit"
- (:value s1) => \/
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0120
- (let [s1 (parse char-lit "'\\x0041'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0125
- (let [s1 (parse char-lit "'\\o101'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0130
- (let [s1 (parse char-lit "'\\90'")]
- (fact "char-lit"
- (:value s1) => \Z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_lexer_haskell.cljc b/src/test/clojure/blancas/kern/test_lexer_haskell.cljc
new file mode 100644
index 0000000..d4cb383
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_lexer_haskell.cljc
@@ -0,0 +1,295 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns blancas.kern.test-lexer-haskell
+ (:require [blancas.kern.core :as k :refer [parse >>]]
+ [blancas.kern.lexer.haskell-style :as lex]
+ [clojure.test :refer [deftest is testing]]))
+
+;; +-------------------------------------------------------------+
+;; | Haskell-style lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse (>> lex/trim k/eof) " \t\t\n")]
+ (testing "trim - blank, tab, eol, then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0005
+ (let [s1 (parse (>> lex/trim (k/many k/digit)) "123")]
+ (testing "trim - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0010
+ (let [s1 (parse (>> lex/trim (k/many1 k/letter)) " {- comment -} \t\n\t\t ABC")]
+ (testing "trim - whitespace before letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0015
+ (let [s1 (parse (>> (lex/lexeme (k/sym* \space)) k/eof) " \t\t\n")]
+ (testing "lexeme - a blank, then tab, eol; then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0020
+ (let [s1 (parse (lex/lexeme (k/many k/digit)) "123")]
+ (testing "lexeme - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0025
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "ABC {- that's it -} \t\n\t\t")]
+ (testing "lexeme - whitespace and comments after letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0030
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "foo -- and the rest is history\nbar")]
+ (testing "trim - single-line comment"
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\b \a \r] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0035
+ (let [in "foo -- variable\n-- that's all\n-- for now\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple single-line comments"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0040
+ (let [in "foo {- var foo\n that's all\n for now -}\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0045
+ (let [in "foo{-----this is a comment------}"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (empty? (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0050
+ (let [in "foo{-----this is {---- inner comment ----} an outer comment------}"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips nested comments"
+ (is (empty? (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0055
+ (let [in "foo{---outer {---- inner {---- most inner ----} less inner ----} outer ----}"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips nested comments"
+ (is (empty? (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0060
+ (let [in "foo{-----this is a comment------"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "lexeme - fails looking for end of comment"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected end of input\nexpecting end of comment" em)))))
+
+
+(deftest test-0065
+ (let [in "foo{-----this is a {- NESTED comment------}"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "lexeme - fails looking for end of a nested comment"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected end of input\nexpecting end of comment" em)))))
+
+
+(deftest test-0070
+ (let [s1 (parse lex/char-lit "'z'")]
+ (testing "char-lit"
+ (is (= \z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0075
+ (let [s1 (parse lex/char-lit "'\\b'")]
+ (testing "char-lit"
+ (is (= \backspace (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0080
+ (let [s1 (parse lex/char-lit "'\\t'")]
+ (testing "char-lit"
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0085
+ (let [s1 (parse lex/char-lit "'\\n'")]
+ (testing "char-lit"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0090
+ (let [s1 (parse lex/char-lit "'\\f'")]
+ (testing "char-lit"
+ (is (= \formfeed (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0095
+ (let [s1 (parse lex/char-lit "'\\r'")]
+ (testing "char-lit"
+ (is (= \return (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0100
+ (let [s1 (parse lex/char-lit "'\\''")]
+ (testing "char-lit"
+ (is (= \' (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0105
+ (let [s1 (parse lex/char-lit "'\\\"'")]
+ (testing "char-lit"
+ (is (= \" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0110
+ (let [s1 (parse lex/char-lit "'\\\\'")]
+ (testing "char-lit"
+ (is (= \\ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0115
+ (let [s1 (parse lex/char-lit "'\\/'")]
+ (testing "char-lit"
+ (is (= \/ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0120
+ (let [s1 (parse lex/char-lit "'\\x0041'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0125
+ (let [s1 (parse lex/char-lit "'\\o101'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0130
+ (let [s1 (parse lex/char-lit "'\\90'")]
+ (testing "char-lit"
+ (is (= \Z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
diff --git a/src/test/clojure/blancas/kern/test_lexer_java.clj b/src/test/clojure/blancas/kern/test_lexer_java.clj
deleted file mode 100644
index 12ceb7d..0000000
--- a/src/test/clojure/blancas/kern/test_lexer_java.clj
+++ /dev/null
@@ -1,343 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-lexer-java
- (:use [blancas.kern.core]
- [blancas.kern.lexer.java-style]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)]))
-
-;; Private functions from kern.core
-
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-
-
-;; +-------------------------------------------------------------+
-;; | Java-style lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse (>> trim eof) " \t\t\n")]
- (fact "trim - blank, tab, eol, then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0005
- (let [s1 (parse (>> trim (many digit)) "123")]
- (fact "trim - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0010
- (let [s1 (parse (>> trim (many1 letter)) " /* comment */ \t\n\t\t ABC")]
- (fact "trim - whitespace before letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0015
- (let [s1 (parse (>> (lexeme (sym* \space)) eof) " \t\t\n")]
- (fact "lexeme - a blank, then tab, eol; then eof"
- (:value s1) => nil
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0020
- (let [s1 (parse (lexeme (many digit)) "123")]
- (fact "lexeme - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0025
- (let [s1 (parse (lexeme (many1 letter)) "ABC /* that's it */ \t\n\t\t")]
- (fact "lexeme - whitespace and comments after letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0030
- (let [s1 (parse (lexeme (many1 letter)) "foo // and the rest is history\nbar")]
- (fact "trim - single-line comment"
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\b \a \r]
- (:empty s1) => false)))
-
-
-(deftest test-0035
- (let [in "foo // variable\n// that's all\n// for now\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple single-line comments"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0040
- (let [s1 (parse (lexeme (many1 letter)) "foo // and the rest is history")]
- (fact "trim - single-line comment at end of input"
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0045
- (let [in "foo /* var foo\n that's all\n for now */\nbar"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => [\b \a \r]
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0050
- (let [in "foo/********this is a comment**********/"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - skips over multiple multi-line comment"
- (:input s1) => empty?
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false
- (:error s1) => nil)))
-
-
-(deftest test-0055
- (let [in "foo/****** this is a comment*****"
- s1 (parse (lexeme (many1 letter)) in)
- em (get-msg-str (:error s1))]
- (fact "lexeme - fails looking for end of comment"
- (:input s1) => empty?
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected end of input\nexpecting end of comment")))
-
-
-(deftest test-0060
- (let [in "foo/******* this is a /* CAN I NEST? */ comment ********/"
- s1 (parse (lexeme (many1 letter)) in)]
- (fact "lexeme - Won't da nested comment; but this works and stops at 'comment'"
- (:input s1) => (seq "comment ********/")
- (:value s1) => [\f \o \o]
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0066
- (let [s1 (parse char-lit "'z'")]
- (fact "char-lit"
- (:value s1) => \z
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0070
- (let [s1 (parse char-lit "'\\b'")]
- (fact "char-lit"
- (:value s1) => \backspace
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0075
- (let [s1 (parse char-lit "'\\t'")]
- (fact "char-lit"
- (:value s1) => \tab
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0080
- (let [s1 (parse char-lit "'\\n'")]
- (fact "char-lit"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0085
- (let [s1 (parse char-lit "'\\f'")]
- (fact "char-lit"
- (:value s1) => \formfeed
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0090
- (let [s1 (parse char-lit "'\\r'")]
- (fact "char-lit"
- (:value s1) => \return
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0095
- (let [s1 (parse char-lit "'\\''")]
- (fact "char-lit"
- (:value s1) => \'
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0100
- (let [s1 (parse char-lit "'\\\"'")]
- (fact "char-lit"
- (:value s1) => \"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0105
- (let [s1 (parse char-lit "'\\\\'")]
- (fact "char-lit"
- (:value s1) => \\
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0110
- (let [s1 (parse char-lit "'\\/'")]
- (fact "char-lit"
- (:value s1) => \/
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0115
- (let [s1 (parse char-lit "'\\u0041'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0120
- (let [s1 (parse char-lit "'\\101'")]
- (fact "char-lit"
- (:value s1) => \A
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0125
- (let [in "'a "
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails without the closing quote"
- (:input s1) => [\space]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\space\nexpecting end of character literal")))
-
-
-(deftest test-0130
- (let [in "'\\u2'"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails: incomplete unicode number"
- (:input s1) => [\']
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\'\nexpecting hexadecimal digit")))
-
-
-(deftest test-0135
- (let [in "'\\50*"
- s1 (parse char-lit in)
- em (get-msg-str (:error s1))]
- (fact "char-lit - fails: incomplete octal number"
- (:input s1) => [\*]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => false
- em => "unexpected \\*\nexpecting end of character literal")))
-
-
-(deftest test-0140
- (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses a simple string literal"
- (:input s1) => [\| \;]
- (:value s1) => "\bnow\tis\nthe\ftime\r"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0145
- (let [in "\"\\tnow is \\u0074\\u0068\\u0065 time\" \t\t|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses unicode characters"
- (:input s1) => [\| \;]
- (:value s1) => "\tnow is the time"
- (:ok s1) => true
- (:empty s1) => false)))
-
-
-(deftest test-0150
- (let [in "\"now is \\164\\150\\145 time\" /* the */|;"
- s1 (parse string-lit in)]
- (fact "string-lit - parses octal characters"
- (:input s1) => [\| \;]
- (:value s1) => "now is the time"
- (:ok s1) => true
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_lexer_java.cljc b/src/test/clojure/blancas/kern/test_lexer_java.cljc
new file mode 100644
index 0000000..16672a5
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_lexer_java.cljc
@@ -0,0 +1,343 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns blancas.kern.test-lexer-java
+ (:require [blancas.kern.core :as k :refer [parse >>]]
+ [blancas.kern.lexer.java-style :as lex]
+ [clojure.test :refer [deftest is testing]]))
+
+;; +-------------------------------------------------------------+
+;; | Java-style lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse (>> lex/trim k/eof) " \t\t\n")]
+ (testing "trim - blank, tab, eol, then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0005
+ (let [s1 (parse (>> lex/trim (k/many k/digit)) "123")]
+ (testing "trim - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0010
+ (let [s1 (parse (>> lex/trim (k/many1 k/letter)) " /* comment */ \t\n\t\t ABC")]
+ (testing "trim - whitespace before letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0015
+ (let [s1 (parse (>> (lex/lexeme (k/sym* \space)) k/eof) " \t\t\n")]
+ (testing "lexeme - a blank, then tab, eol; then eof"
+ (is (nil? (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0020
+ (let [s1 (parse (lex/lexeme (k/many k/digit)) "123")]
+ (testing "lexeme - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0025
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "ABC /* that's it */ \t\n\t\t")]
+ (testing "lexeme - whitespace and comments after letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0030
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "foo // and the rest is history\nbar")]
+ (testing "trim - single-line comment"
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\b \a \r] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0035
+ (let [in "foo // variable\n// that's all\n// for now\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple single-line comments"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0040
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "foo // and the rest is history")]
+ (testing "trim - single-line comment at end of input"
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0045
+ (let [in "foo /* var foo\n that's all\n for now */\nbar"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (= [\b \a \r] (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0050
+ (let [in "foo/********this is a comment**********/"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - skips over multiple multi-line comment"
+ (is (empty? (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1)))
+ (is (nil? (:error s1))))))
+
+
+(deftest test-0055
+ (let [in "foo/****** this is a comment*****"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)
+ em (k/get-msg-str (:error s1))]
+ (testing "lexeme - fails looking for end of comment"
+ (is (empty? (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= "unexpected end of input\nexpecting end of comment" em)))))
+
+
+(deftest test-0060
+ (let [in "foo/******* this is a /* CAN I NEST? */ comment ********/"
+ s1 (parse (lex/lexeme (k/many1 k/letter)) in)]
+ (testing "lexeme - Won't da nested comment; but this works and stops at 'comment'"
+ (is (= (seq "comment ********/") (:input s1)))
+ (is (= [\f \o \o] (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0066
+ (let [s1 (parse lex/char-lit "'z'")]
+ (testing "char-lit"
+ (is (= \z (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0070
+ (let [s1 (parse lex/char-lit "'\\b'")]
+ (testing "char-lit"
+ (is (= \backspace (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0075
+ (let [s1 (parse lex/char-lit "'\\t'")]
+ (testing "char-lit"
+ (is (= \tab (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0080
+ (let [s1 (parse lex/char-lit "'\\n'")]
+ (testing "char-lit"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0085
+ (let [s1 (parse lex/char-lit "'\\f'")]
+ (testing "char-lit"
+ (is (= \formfeed (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0090
+ (let [s1 (parse lex/char-lit "'\\r'")]
+ (testing "char-lit"
+ (is (= \return (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0095
+ (let [s1 (parse lex/char-lit "'\\''")]
+ (testing "char-lit"
+ (is (= \' (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0100
+ (let [s1 (parse lex/char-lit "'\\\"'")]
+ (testing "char-lit"
+ (is (= \" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0105
+ (let [s1 (parse lex/char-lit "'\\\\'")]
+ (testing "char-lit"
+ (is (= \\ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0110
+ (let [s1 (parse lex/char-lit "'\\/'")]
+ (testing "char-lit"
+ (is (= \/ (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0115
+ (let [s1 (parse lex/char-lit "'\\u0041'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0120
+ (let [s1 (parse lex/char-lit "'\\101'")]
+ (testing "char-lit"
+ (is (= \A (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0125
+ (let [in "'a "
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails without the closing quote"
+ (is (= [\space] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\space\nexpecting end of character literal"
+ :cljs "unexpected \" \"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0130
+ (let [in "'\\u2'"
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails: incomplete unicode number"
+ (is (= [\'] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\'\nexpecting hexadecimal digit"
+ :cljs "unexpected \"'\"\nexpecting hexadecimal digit")
+ em)))))
+
+
+(deftest test-0135
+ (let [in "'\\50*"
+ s1 (parse lex/char-lit in)
+ em (k/get-msg-str (:error s1))]
+ (testing "char-lit - fails: incomplete octal number"
+ (is (= [\*] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (false? (:empty s1)))
+ (is (= #?(:clj "unexpected \\*\nexpecting end of character literal"
+ :cljs "unexpected \"*\"\nexpecting end of character literal")
+ em)))))
+
+
+(deftest test-0140
+ (let [in "\"\\bnow\\tis\\nthe\\ftime\\r\" \t\t|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses a simple string literal"
+ (is (= [\| \;] (:input s1)))
+ (is (= "\bnow\tis\nthe\ftime\r" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0145
+ (let [in "\"\\tnow is \\u0074\\u0068\\u0065 time\" \t\t|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses unicode characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "\tnow is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0150
+ (let [in "\"now is \\164\\150\\145 time\" /* the */|;"
+ s1 (parse lex/string-lit in)]
+ (testing "string-lit - parses octal characters"
+ (is (= [\| \;] (:input s1)))
+ (is (= "now is the time" (:value s1)))
+ (is (:ok s1))
+ (is (false? (:empty s1))))))
diff --git a/src/test/clojure/blancas/kern/test_lexer_shell.clj b/src/test/clojure/blancas/kern/test_lexer_shell.clj
deleted file mode 100644
index 8aebd02..0000000
--- a/src/test/clojure/blancas/kern/test_lexer_shell.clj
+++ /dev/null
@@ -1,153 +0,0 @@
-;; Copyright (c) 2013 Armando Blancas. All rights reserved.
-;; The use and distribution terms for this software are covered by the
-;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file epl-v10.html at the root of this distribution.
-;; By using this software in any fashion, you are agreeing to be bound by
-;; the terms of this license.
-;; You must not remove this notice, or any other, from this software.
-
-(ns blancas.kern.test-lexer-shell
- (:use [blancas.kern.core]
- [blancas.kern.lexer.shell-style]
- [clojure.test]
- [midje.sweet :exclude (expect one-of)]))
-
-;; Private functions from kern.core
-
-(def get-msg-str (ns-resolve 'blancas.kern.core 'get-msg-str))
-
-
-;; +-------------------------------------------------------------+
-;; | Shell-style lexers. |
-;; +-------------------------------------------------------------+
-
-
-(deftest test-0000
- (let [s1 (parse (>> trim new-line) " \t\t\n")]
- (fact "trim - blank, tab, eol, then a new line (separately)"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0005
- (let [s1 (parse (>> trim (many digit)) "123")]
- (fact "trim - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0010
- (let [s1 (parse (>> (skip trim new-line) (many1 letter)) " \t\t\nABC")]
- (fact "trim - some whitespace before letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0015
- (let [s1 (parse (<*> (lexeme (sym* \space)) new-line eof) " \t\t\n")]
- (fact "lexeme - a blank, then tab, eol; then eof"
- (:value s1) => [\space \newline nil]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0020
- (let [s1 (parse (lexeme (many digit)) "123")]
- (fact "lexeme - no whitespace, it's optional"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0025
- (let [s1 (parse (lexeme (many1 letter)) "ABC \t\t\t")]
- (fact "lexeme - some whitespace after letters"
- (:value s1) => [\A \B \C]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0030
- (let [s1 (parse new-line "\nfoo")]
- (fact "new-line - parses a new line and stops"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0035
- (let [s1 (parse new-line "\n\t\t foo")]
- (fact "new-line - skip a new line and any other whitespace that follows"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0040
- (let [s1 (parse new-line "\r\nfoo")]
- (fact "new-line - parses a Windows new-line and stops"
- (:value s1) => \newline
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\f \o \o]
- (:empty s1) => false)))
-
-
-(deftest test-0045
- (let [s1 (parse new-line "foo")
- em (get-msg-str (:error s1))]
- (fact "new-line - fails when there's no new-line"
- (:input s1) => [\f \o \o]
- (:value s1) => nil
- (:ok s1) => false
- (:empty s1) => true
- em => "unexpected \\f\nexpecting new line")))
-
-
-(deftest test-0050
- (let [s1 (parse (lexeme (many digit)) "123 # and the rest is history...")]
- (fact "lexeme - skip over a line comment"
- (:value s1) => [\1 \2 \3]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
-
-
-(deftest test-0055
- (let [s1 (parse identifier "init.phase-123_last=")]
- (fact "lexeme - identifier with - and ."
- (:value s1) => "init.phase-123_last"
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => [\=]
- (:empty s1) => false)))
-
-
-(deftest test-0060
- (let [s1 (parse (many1 identifier) "abc def ghi \\\nxyz")]
- (fact "lexeme - line continuation; no new line to skip"
- (:value s1) => ["abc" "def" "ghi" "xyz"]
- (:ok s1) => true
- (:error s1) => nil
- (:input s1) => empty?
- (:empty s1) => false)))
diff --git a/src/test/clojure/blancas/kern/test_lexer_shell.cljc b/src/test/clojure/blancas/kern/test_lexer_shell.cljc
new file mode 100644
index 0000000..c431277
--- /dev/null
+++ b/src/test/clojure/blancas/kern/test_lexer_shell.cljc
@@ -0,0 +1,150 @@
+;; Copyright (c) 2013 Armando Blancas. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns blancas.kern.test-lexer-shell
+ (:require [blancas.kern.core :as k :refer [parse >> <*>]]
+ [blancas.kern.lexer.shell-style :as lex]
+ [clojure.test :refer [deftest is testing]]))
+
+
+;; +-------------------------------------------------------------+
+;; | Shell-style lexers. |
+;; +-------------------------------------------------------------+
+
+
+(deftest test-0000
+ (let [s1 (parse (>> lex/trim lex/new-line) " \t\t\n")]
+ (testing "trim - blank, tab, eol, then a new line (separately)"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0005
+ (let [s1 (parse (>> lex/trim (k/many k/digit)) "123")]
+ (testing "trim - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0010
+ (let [s1 (parse (>> (k/skip lex/trim lex/new-line) (k/many1 k/letter)) " \t\t\nABC")]
+ (testing "trim - some whitespace before letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0015
+ (let [s1 (parse (<*> (lex/lexeme (k/sym* \space)) lex/new-line k/eof) " \t\t\n")]
+ (testing "lexeme - a blank, then tab, eol; then eof"
+ (is (= [\space \newline nil] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0020
+ (let [s1 (parse (lex/lexeme (k/many k/digit)) "123")]
+ (testing "lexeme - no whitespace, it's optional"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0025
+ (let [s1 (parse (lex/lexeme (k/many1 k/letter)) "ABC \t\t\t")]
+ (testing "lexeme - some whitespace after letters"
+ (is (= [\A \B \C] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0030
+ (let [s1 (parse lex/new-line "\nfoo")]
+ (testing "new-line - parses a new line and stops"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0035
+ (let [s1 (parse lex/new-line "\n\t\t foo")]
+ (testing "new-line - skip a new line and any other whitespace that follows"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0040
+ (let [s1 (parse lex/new-line "\r\nfoo")]
+ (testing "new-line - parses a Windows new-line and stops"
+ (is (= \newline (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\f \o \o] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0045
+ (let [s1 (parse lex/new-line "foo")
+ em (k/get-msg-str (:error s1))]
+ (testing "new-line - fails when there's no new-line"
+ (is (= [\f \o \o] (:input s1)))
+ (is (nil? (:value s1)))
+ (is (false? (:ok s1)))
+ (is (:empty s1))
+ (is (= #?(:clj "unexpected \\f\nexpecting new line"
+ :cljs "unexpected \"f\"\nexpecting new line")
+ em)))))
+
+
+(deftest test-0050
+ (let [s1 (parse (lex/lexeme (k/many k/digit)) "123 # and the rest is history...")]
+ (testing "lexeme - skip over a line comment"
+ (is (= [\1 \2 \3] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0055
+ (let [s1 (parse lex/identifier "init.phase-123_last=")]
+ (testing "lexeme - identifier with - and ."
+ (is (= "init.phase-123_last" (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (= [\=] (:input s1)))
+ (is (false? (:empty s1))))))
+
+
+(deftest test-0060
+ (let [s1 (parse (k/many1 lex/identifier) "abc def ghi \\\nxyz")]
+ (testing "lexeme - line continuation; no new line to skip"
+ (is (= ["abc" "def" "ghi" "xyz"] (:value s1)))
+ (is (:ok s1))
+ (is (nil? (:error s1)))
+ (is (empty? (:input s1)))
+ (is (false? (:empty s1))))))