fixed bugs with special char parsers

added even more parser tests

src/clparsec/char_parsers.clj

@@ -61,17 +61,25 @@
 (defn- satisfyE [pred e-msg]
   (fn [state]
     (if-let [c (peep state)]
-      (if (pred c)
-        (make-success (skip-one state) c)
-        (make-failure state (make-parse-error state e-msg)))
+      (case c
+        (\return \newline) (if (pred \newline)
+                             (make-success (skip-newline state) \newline)
+                             (make-failure state (make-parse-error state e-msg)))
+        (if (and (not= c \uffff) (pred c))
+          (make-success (skip-one state) c)
+          (make-failure state (make-parse-error state e-msg))))
       (make-failure state (make-parse-error state e-msg)))))
 
 (defn- skip-satisfyE [pred e-msg]
   (fn [state]
     (if-let [c (peep state)]
-      (if (pred c)
-        (make-success (skip-one state) nil)
-        (make-failure state (make-parse-error state e-msg)))
+      (case c
+        (\return \newline) (if (pred \newline)
+                             (make-success (skip-newline state) nil)
+                             (make-failure state (make-parse-error state e-msg)))
+        (if (and (not= c \uffff) (pred c))
+          (make-success (skip-one state) nil)
+          (make-failure state (make-parse-error state e-msg))))
       (make-failure state (make-parse-error state e-msg)))))
 
 (defn satisfy [pred]
@@ -93,36 +101,50 @@
 (defn any-of-set [chars]
   (satisfyE chars (expected-any-char-in chars)))
 
+(defn skip-any-of [& chars]
+  (let [chars (set chars)]
+    (skip-satisfyE chars (expected-any-char-in chars))))
+
+(defn skip-any-of-set [chars]
+  (skip-satisfyE chars (expected-any-char-in chars)))
+
 (defn none-of [& chars]
   (let [chars (set chars)]
     (satisfyE (comp not chars) (expected-any-char-not-in chars))))
 
 (defn none-of-set [chars]
   (satisfyE (comp not chars) (expected-any-char-not-in chars)))
 
+(defn skip-none-of [& chars]
+  (let [chars (set chars)]
+    (skip-satisfyE (comp not chars) (expected-any-char-not-in chars))))
+
+(defn skip-none-of-set [chars]
+  (skip-satisfyE (comp not chars) (expected-any-char-not-in chars)))
+
 (defn char-lte? [a b]
-  (=(.compareTo a b) -1)) 
+  (<=(.compareTo a b) 0)) 
 (defn char-gte? [a b]
-  (= (.compareTo a b) 1))
+  (>= (.compareTo a b) 0))
 
 
 (defn- is-ascii-upper? [c]
-  (and (char-lte? c \A) (char-gte? c \Z)))
+  (and (char-gte? c \A) (char-lte? c \Z)))
 
 (defn- is-ascii-lower? [c]
-  (and (char-lte? c \a) (char-gte? c \z)))
+  (and (char-gte? c \a) (char-lte? c \z)))
 
 (defn- is-digit? [c]
-  (and (char-lte? c \0) (char-gte? c \9)))
+  (and (char-gte? c \0) (char-lte? c \9)))
 
 (defn- is-hex? [c]
-  (or (and (char-lte? c \0) (char-gte? c \9))) (and (char-lte? c \A) (char-gte? c \F)))
+  (or (and (char-gte? c \0) (char-lte? c \9))) (and (char-gte? c \A) (char-lte? c \F)))
 (defn- is-ascii-letter? [c]
   (or (is-ascii-upper? c) (is-ascii-lower? c)))
 
-(def ascii-upper (partial satisfyE is-ascii-upper? (expected "ascii-uppercase-letter")))
-(def ascii-lower (partial satisfyE is-ascii-lower? (expected "ascii-lowercase-letter")))
-(def ascii-letter (partial satisfyE is-ascii-letter? (expected "ascii-uppercase-letter")))
+(def ascii-upper (satisfyE is-ascii-upper? (expected "ascii-uppercase-letter")))
+(def ascii-lower (satisfyE is-ascii-lower? (expected "ascii-lowercase-letter")))
+(def ascii-letter (satisfyE is-ascii-letter? (expected "ascii-letter")))
 
 (defn is-upper-case? [c]
   (Character/isUpperCase c))
@@ -131,18 +153,19 @@
 (defn is-letter? [c]
   (Character/isLetter c))
 
-(def upper (partial satisfyE is-upper-case? (expected "uppercase-letter")))
-(def lower (partial satisfyE is-lower-case? (expected "lower-letter")))
-(def letter (partial satisfyE is-letter? (expected "letter")))
+(def upper (satisfyE is-upper-case? (expected "uppercase-letter")))
+(def lower (satisfyE is-lower-case? (expected "lowercase-letter")))
+(def letter (satisfyE is-letter? (expected "letter")))
 
-(def digit (partial satisfyE is-digit? (expected "decimal-digit")))
-(def hex (partial satisfyE is-hex? (expected "hexadecimal-digit")))
+(def digit (satisfyE is-digit? (expected "decimal-digit")))
+(def hex (satisfyE is-hex? (expected "hexadecimal-digit")))
 
-(def tab (partial satisfyE #(= % \t) (expected "tab")))
+(def tab (satisfyE #(= % \tab) (expected "tab")))
 
 (defn spaces [state]
-  (let [s (skip-whitespace state)]
-    (make-success s)))
+  (if-let [s (skip-whitespace state)]
+    (make-success s)
+    (make-success state)))
 
 (defn spaces1 [state]
   (if-let [s (skip-whitespace state)]
@@ -196,8 +219,4 @@
   (many1-satisfy2L f f label))
 
 
-;;;;;; experimental ;;;;;;;;;;;;;
-
-(defn parse [p str]
-  (p (make-state str)))
 

src/clparsec/core.clj

@@ -37,7 +37,7 @@
   ALocation
     (location-code [this] (format "line %s, column %s" line column))
   ALineAndColumnLocation
-    (location-inc-line [this] (assoc this :line (inc line), :column 0))
+    (location-inc-line [this] (assoc this :line (inc line), :column 1))
     (location-inc-column [this] (assoc this :column (inc column)))
     (location-plus-column [this n] (assoc this :column (+ column n))))
 
@@ -134,7 +134,7 @@
 (defn make-state
   "Creates a state with the given parameters."
   [input & {:keys #{location context alter-location}
-            :or {location (make-standard-location 0 0), alter-location
+            :or {location (make-standard-location 1 1), alter-location
                  standard-alter-location}}]
   {:pre #{(or (nil? location) (location? location)) (ifn? alter-location)}}
   (State. input 0 location #{} context alter-location))
@@ -204,4 +204,7 @@
 (defn expected-list [label] (#{expected}))
 
 (defn swap-error-messages [reply messages]
-  (assoc reply :errors (assoc (:errors reply) :messages messages)))  
+  (assoc reply :errors (assoc (:errors reply) :messages messages)))  
+
+(defn run [p str]
+  (p (make-state str)))

test/clparsec/test/char_parsers.clj

@@ -13,7 +13,7 @@
       (is (= (:messages (:errors res)) errors))
       (is (= (get-position (:state res)) nskipped-chars))
       (if with-newline
-        (is (=(:line (location (:state res)))1))))))
+        (is (=(:line (location (:state res))) 2))))))
 
 (defn rok 
   "result ok"
@@ -98,6 +98,94 @@
   (rok (satisfy #(= % \1)) "11" 1 \1)
   (rfail (satisfy #(= % \1)) "0" 0 #{nil})
   (rfail (satisfyL #(= % \1) "test") "2" 0 #{(expected "test")})
-  (rfail (satisfyL #(= % \return) "test") "0" 0 #{(expected "test")}))
+  (rfail (satisfyL #(= % \return) "test") "\r" 0 #{(expected "test")})
+  (roknl (satisfy #(= % \newline)) "\r" 1 \newline)
+  (roknl (satisfy #(= % \newline)) "\r\n" 2 \newline)
+  (roknl (satisfy #(= % \newline)) "\n" 1 \newline))
 
-
+(deftest test-skip-satisfy
+  (rok (skip-satisfy #(= % \1)) "1" 1 nil)
+  (rok (skip-satisfy #(= % \tab)) "\t" 1 nil)
+  (rok (skip-satisfy #(= % \1)) "11" 1 nil)
+  (rfail (skip-satisfy #(= % \1)) "0" 0 #{nil})
+  (rfail (skip-satisfyL #(= % \1) "test") "2" 0 #{(expected "test")})
+  (rfail (skip-satisfyL #(= % \return) "test") "\r" 0 #{(expected "test")})
+  (roknl (skip-satisfy #(= % \newline)) "\r" 1 nil)
+  (roknl (skip-satisfy #(= % \newline)) "\r\n" 2 nil)
+  (roknl (skip-satisfy #(= % \newline)) "\n" 1 nil))
+
+(deftest test-any-of
+  (rok (any-of \1 \2) "12" 1 \1)
+  (rok (any-of-set #{\1 \2}) "12" 1 \1)
+  (roknl (any-of \1 \newline) "\r" 1 \newline)
+  (roknl (any-of \1 \newline) "\r\n" 2 \newline)
+  (rfail (any-of \1 \2) "3" 0 #{(expected-any-char-in #{\1 \2})})
+  (rfail (any-of \1 \return) "\r" 0 #{(expected-any-char-in #{\1 \return})})
+  (rfail (any-of-set #{\1 \2}) "3" 0 #{(expected-any-char-in #{\1 \2})}))
+
+(deftest test-none-of
+  (rok (none-of \1 \2) "3" 1 \3)
+  (rok (none-of-set #{\1 \2}) "3" 1 \3)
+  (rok (none-of \1 \2) "\r" 1 \newline)
+  (rok (none-of \1 \2) "\r\n" 2 \newline)
+  (rfail (none-of \1 \2) "1" 0 #{(expected-any-char-not-in #{\1 \2})})
+  (rfail (none-of \1 \newline) "\n" 0 #{(expected-any-char-not-in #{\1 \newline})})
+  (rfail (none-of-set #{\1 \2}) "1" 0 #{(expected-any-char-not-in #{\1 \2})}))
+
+(deftest test-skip-any-of
+  (rok (skip-any-of \1 \2) "12" 1 nil)
+  (rok (skip-any-of-set #{\1 \2}) "12" 1 nil)
+  (roknl (skip-any-of \1 \newline) "\r" 1 nil)
+  (roknl (skip-any-of \1 \newline) "\r\n" 2 nil)
+  (rfail (skip-any-of \1 \2) "3" 0 #{(expected-any-char-in #{\1 \2})})
+  (rfail (skip-any-of \1 \return) "\r" 0 #{(expected-any-char-in #{\1 \return})})
+  (rfail (skip-any-of-set #{\1 \2}) "3" 0 #{(expected-any-char-in #{\1 \2})}))
+
+(deftest test-skip-none-of
+  (rok (skip-none-of \1 \2) "3" 1 nil)
+  (rok (skip-none-of-set #{\1 \2}) "3" 1 nil)
+  (rok (skip-none-of \1 \2) "\r" 1 nil)
+  (rok (skip-none-of \1 \2) "\r\n" 2 nil)
+  (rfail (skip-none-of \1 \2) "1" 0 #{(expected-any-char-not-in #{\1 \2})})
+  (rfail (skip-none-of \1 \newline) "\n" 0 #{(expected-any-char-not-in #{\1 \newline})})
+  (rfail (skip-none-of-set #{\1 \2}) "1" 0 #{(expected-any-char-not-in #{\1 \2})}))
+
+(deftest test-ascii-parsers
+  (rok ascii-upper "A" 1 \A)
+  (rok ascii-lower "a" 1 \a)
+  (rok ascii-letter "A" 1 \A)
+  (rfail ascii-upper "z" 0 #{(expected "ascii-uppercase-letter")})
+  (rfail ascii-lower "A" 0 #{(expected "ascii-lowercase-letter")})
+  (rfail ascii-letter "1" 0 #{(expected "ascii-letter")}))
+
+(deftest test-letter-parsers
+  (rok upper "Ä" 1 \Ä)
+  (rok lower "ä" 1 \ä)
+  (rok letter "Ü" 1 \Ü)
+  (rfail upper "ä" 0 #{(expected "uppercase-letter")})
+  (rfail lower "Ä" 0 #{(expected "lowercase-letter")})
+  (rfail letter "1" 0 #{(expected "letter")}))
+
+(deftest test-digit-parsers
+  (rok digit "1" 1 \1)
+  (rok hex "F" 1 \F)
+  (rfail digit "z" 0 #{(expected "decimal-digit")})
+  (rfail hex "G" 0 #{(expected "hexadecimal-digit")}))
+
+(deftest test-tab
+  (rok tab "\t" 1 \tab)
+  (rfail tab "a" 0 #{(expected "tab")}))
+
+(deftest test-spaces
+  (rok spaces "" 0 nil)
+  (rok spaces " " 1 nil)
+  (rok spaces "  " 2 nil)
+  (rfail spaces1 "" 0 #{(expected "whitespace")})
+  (rok spaces1 " " 1 nil)
+  (rok spaces1 "  " 2 nil))
+
+(deftest test-spaces-with-newlines
+  (let [res (run spaces "\n \r\t\t\r\n\n ")]
+    (is (= (get-position(:state res))9))
+    (is (= (:line (location (:state res))) 5))
+    (is (= (:column (location (:state res))) 2))))