added tests

2 files changed, 85 insertions, 56 deletions

diff --git a/parzival.lisp b/parzival.lisp
index d08c157..26a2cfd 100644
--- a/parzival.lisp
+++ b/parzival.lisp
@@ -108,21 +108,32 @@ in then. If the parse fails the combinator else is run instead."
 ;;; The <<PLUS COMBINATOR is vital, and gives us amazing powers to choose our
 ;;; own future!  This section defines <<plus and uses it to define some nice utilities.
 
+
+;;; TODO - what could make this more efficient is if there was some kind of
+;;; "cleanup stream" function that would search for the smallest safe stream
+;;; abstraction to return in case of a success. Call it instead of
+;;; recover-source.
 (defun <<plus (parser1 parser2)
   "Introduces a choice between two parsers. If PARSER1 succeeds then its result
-is used. If PARSER1 fails then the stream is rewound and tried again with
-PARSER2."
-  (lambda (stream)
-    (let ((stream2 (replay-on stream)))
+  is used. If PARSER1 fails then the stream is rewound and tried again with
+  PARSER2."
+  (lambda (stream1)
+    ;; we need stream2 to rewind from in case of failure
+    (let ((stream2 (replay-on stream1)))
       (<<if (result parser1 stream2)
+            ;; stream3 is whatever parser1 has created, it might be anything
             (lambda (stream3)
               (funcall (<<result result)
+                       ;; to save memory when possible, we recover the
+                       ;; underlying stream. Only safe to do when stream3 IS stream2
                        (if (eq stream3 stream2)
-                           (recover-source stream2)
+                           (recover-source stream2) ;; a.k.a. stream1
                            stream3)))
             (lambda (stream3)
+              ;; in case of failure, we rewind from stream2 and try anew.
               (funcall parser2 (rewind stream2)))))))
 
+
 (defun <<or (parser1 parser2 &rest parsers)
   "Tries each parser one after the other, rewinding the input stream after each
 failure, and resulting in the first successful parse."
@@ -317,12 +328,6 @@ the character C."
           (<<map-cons result (<<* parser))
           (<<result nil))))
 
-  ;; (<<bind (<<? parser)
-  ;;         (lambda (val) (if val
-  ;;                           (<<map-cons val (<<* parser))
-  ;;                           (<<result nil)))))
-
-
 (defun <<+ (parser)
   "Like <<* but fails if P does not succeed at least once."
   (<<cons parser (<<* parser)))
@@ -361,8 +366,6 @@ the character C."
                          (<<map-cons val (<<sep-by value-parser separator-parser)))
                   (<<result (list val))))))
 
-
-
 ;;; VALUE PARSERS. The following section contains utilities for parsing common
 ;;; values like strings or numbers.
 
diff --git a/tests.lisp b/tests.lisp
index 9b7035d..a4561b9 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -6,47 +6,73 @@
 
 (setf prove:*enable-colors* nil)
 
-(subtest "Testing <<result"
-  (ok (parse "" (<<result t) t))
-  (let* ((stream (make-string-input-stream "hey")))
-    (is (parse stream (<<result 'foo)) 'foo)
-    (is (read-char stream) #\h)))
-
-(subtest "Testing <peek<"
-  (let ((stream (make-string-input-stream "X")))
-    ;; showing that the input isn't being consumed
-    (is (parse stream <peek<) #\X)
-    (is (parse stream <peek<) #\X)))
-
-(subtest "Testing <item<"
-  (is (parse "xxx" <item< t) #\x)
-  (isnt (parse "" <item< t) t))
-
-(subtest "Testing <eof<"
-  (ok (parse "" <eof< t))
-  (isnt (parse "MORE CONTENT" <eof< t) t)
-
-  (let ((stream (make-string-input-stream "abc")))
-    ;; read all the input then test that we're at the end
-    (read-char stream)
-    (read-char stream)
-    (read-char stream)
-    (ok (parse stream <eof<))))
-
-(subtest "Basic <<plus tests"
-  (is (parse "hello" (<<plus <nat< <word<) t) "hello")
-  (is (parse "31hello" (<<plus <nat< <word<) t) 31)
-  (is (parse "33" (<<or <word< <nat< <int<) t) 33)
-  (is (parse "-33" (<<or <word< <nat< <int<) t) -33)
-  (let ((stream1 (make-string-input-stream "abcd")))
-    (multiple-value-bind (res ok? stream2) (parse stream1 (<<~ (<<string "abXd")))
-      (is res nil)            ; The result is NIL, but b/c the parse failed.
-      (is ok? nil)            ; See, the parse should have failed.
-      (isnt stream1 stream2)  ; The streams should now be different objects in memory.
-      ;; Notice that even though "abXd" could have consumed all our input, we're not at the end.
-      (isnt (parse stream2 <eof<) t)
-      ;; But we should still be able to parse "abcd" from STREAM2.
-      (is (parse stream2 (<<string "abcd")) "abcd")
-      ;; Moreover, we should be at the end of the input.
-      (is (parse stream2 <eof<) t))))
+(defmacro test-with ((var input-string) &rest tests)
+  `(subtest (format nil "With the input ~s ..." ,input-string)
+     (let ((,var (make-string-input-stream ,input-string)))
+       ,@tests)))
+
+(defmacro results (stream expr val)
+  (let ((res (gensym))
+        (ok? (gensym))
+        (stream2 (gensym)))
+    `(multiple-value-bind (,res ,ok? ,stream2) (parse ,stream ,expr)
+       (setf ,stream ,stream2) ; is this doing what I want?
+       (is (and ,ok? ,res) ,val (format nil "Parsing with ~s results in ~s" ',expr ',val)))))
+
+(defmacro fails (stream expr)
+  (let ((res (gensym))
+        (ok? (gensym))
+        (stream2 (gensym)))
+    `(multiple-value-bind (,res ,ok? ,stream2) (parse ,stream ,expr)
+       (setf ,stream ,stream2) ; Not sure about this...
+       (unless ,res ; doing this to get rid of warning about unused variable
+         (is ,ok? nil (format nil "Parsing with ~s should fail." ',expr))))))
+
+(test-with (input "hey")
+           (results input (<<result t) t)
+           (results input (<<result 'foo) 'foo))
+
+
+(test-with (input "xxx")
+           (results input <item< #\x)
+           (results input <item< #\x)
+           (results input <item< #\x)
+           (fails input <item<))
+
+(subtest "Testing <<plus"
+  (test-with (input "hello")
+             (results input (<<plus <nat< <word<) "hello")
+             (results input <eof< t))
+
+  (test-with (input "hello31")
+             (results input (<<plus <word< <nat<) "hello")
+             (results input (<<plus <word< <nat<) 31))
+
+  (test-with (input "31hello")
+             (results input (<<plus <nat< <word<) 31)
+             (results input (<<plus <nat< <word<) "hello"))
+
+  (test-with (input "hello31")
+             (results input (<<plus <nat< <word<) "hello")
+             (results input (<<plus <nat< <word<) 31))
+
+  (test-with (input "abcd")
+             (fails input (<<~ (<<string "abXd")))
+             (results input (<<string "abcd") "abcd")
+             (results input <eof< t)))
+
+(subtest "Testing <<and and <<bind"
+  (test-with (input "abcd1234")
+             (results input (<<and <word< (<<ending <nat<)) 1234)))
+
+(subtest "Testing <<*"
+  (test-with (input "abcd1234")
+             (results input (<<* (<<char #\z)) '())
+             (fails input  (<<~ (<<ending <word<)))
+             (results input <word< "abcd")
+             (results input (<<ending (<<* <digit<)) '(#\1 #\2 #\3 #\4))))
+
+
+
+