Commits

carl douglas committed 9a06ddc

Refactor read-response. Return all arguments in response.

Comments (0)

Files changed (2)

                      (sprintf "$~A\r\n~A\r\n" (string-length arg) arg)) args))))
 
 (define (redis-read-response port)
-  (let parse ((argc 1) (args '()))
-       (if (= argc 0)
-          args
-          (let ((ch (read-char port)))
-               (case ch
-                 ((#\+) (list (read-line port)))
-                 ((#\*) (parse (string->number (read-line port)) args))
-                 ((#\$) (parse (- argc 1)
-                          (append args 
-                            (list (read-string (string->number (read-line port)) port)))))
-                 ((#\:)       (list (read-line port)))
-                 ((#\return)  (parse argc args))
-                 ((#\newline) (parse argc args))
-                 (else (error "unrecognised prefix" ch (read-line port))))))))
+  (letrec ((argc 1)(args '())
+           (update-args!
+             (lambda (a) (set! args (append args (list a)))))
+           (single-line 
+             (lambda () (read-line port)))
+           (single-line-number
+             (lambda () (string->number (single-line))))
+           (multi-bulk
+             (lambda () (single-line-number)))
+           (bulk
+             (lambda () (read-string (single-line-number) port)))
+           (next-line
+             (lambda () (if (= argc (length args))
+                          args
+                          (prefix))))
+           (prefix
+             (lambda ()
+               (let ((ch (read-char port)))
+                 (case ch
+                   ((#\+) (begin       ; single line reply
+                            (update-args! (single-line))
+                            (next-line)))
+                   ((#\-) (begin       ; error message
+                            (set! args (single-line))
+                            (next-line)))
+                   ((#\:) (begin       ; integer number
+                            (update-args! (single-line-number))
+                            (next-line)))
+                   ((#\*) (begin       ; multi-bulk
+                            (set! argc (multi-bulk))
+                            (next-line)))
+                   ((#\$) (begin       ; bulk
+                            (update-args! (bulk))
+                            (read-string 2 port)
+                            (next-line)))
+                   (else (error "unrecognised prefix" ch )))))))
+    (prefix)))
 
 (define-syntax map-make-redis-parameter-function
   (ir-macro-transformer
   (if (procedure? b)
     (b a)
     (if (not (equal? a b))
-      (if (not (get-environment-variable SALMONELLA_RUNNING))
+      (if (not (get-environment-variable "SALMONELLA_RUNNING"))
         (error (sprintf "Failed test: ~S != ~S" a b))))))
 
 (redis-connect "127.0.0.1" 6379)
 
+(test (redis-echo "Hello, World!")
+      '("Hello, World!"))
+
 (test (redis-write-command (*redis-out-port*) "ECHO" (list "Hello, World!"))
       (lambda(x)#t))
 (test (redis-read-response (*redis-in-port*))
       '("Hello, World!"))
 
 (test (redis-subscribe "test-channel")
-      '("1"))
+      '("subscribe" "test-channel" 1))
 (test (redis-unsubscribe "test-channel")
-      '("0"))
+      '("unsubscribe" "test-channel" 0))
 
 (test (redis-flushall)
       '("OK"))
 (test (redis-ping) 
       '("PONG"))
 (test (redis-lpush "scheme-test" "1234") 
-      '("1"))
+      '(1))
 (test (redis-rpop "scheme-test") 
       '("1234"))
 (test (redis-rpush "scheme-test" "abc")
-      '("1"))
+      '(1))
 (test (redis-lpop "scheme-test")
       '("abc"))
 (test (redis-publish "channel" "hello")
-      '("0"))
+      '(0))
 (test (redis-set "key1" "value1")
       '("OK"))
 (test (redis-get "key1")
 (test (redis-type "key1")
       '("string"))
 (test (redis-append "key1" "!!!")
-      '("9"))
+      '(9))
 (test (redis-get "key1")
       '("value1!!!"))
 (test (redis-ttl "key1")
-      '("-1"))
+      '(-1))
 (test (redis-expire "key1" "100")
-      '("1"))
+      '(1))
 (test (redis-ttl "key1")
-      '("100"))
+      '(100))
 (test (redis-keys "key*")
       '("key1"))
 (test (redis-exists "key1")
-      '("1"))
+      '(1))
 (test (redis-strlen "key1")
-      '("9"))
+      '(9))
 (test (redis-del "key1")
-      '("1"))
+      '(1))
 (test (redis-set "key2" "1")
       '("OK"))
 (test (redis-incr "key2")
-      '("2"))
+      '(2))
 (test (redis-incrby "key2" "2")
-      '("4"))
+      '(4))
 (test (redis-decr "key2")
-      '("3"))
+      '(3))
 (test (redis-decrby "key2" "2")
-      '("1"))
+      '(1))
 (test (redis-del "key2")
-      '("1"))
+      '(1))
 (test (redis-echo "Hello")
       '("Hello"))
 (test (redis-hset "hash1" "key" "val")
-      '("1"))
+      '(1))
 (test (redis-hget "hash1" "key")
       '("val"))
 (test (redis-hgetall "hash1")
       '("key" "val"))
 (test (redis-hexists "hash1" "key")
-      '("1"))
+      '(1))
 (test (redis-hkeys "hash1")
       '("key"))
 (test (redis-hlen "hash1")
-      '("1"))
+      '(1))
 (test (redis-quit)
       '("OK"))