Chicken/redis
1
0
Fork 0
Code Issues Pull requests Projects Releases 3 Packages Wiki Activity Actions

In the beginning there was darkness

Browse source
This commit is contained in:
Daniel Ziltener 2022-10-25 20:53:47 +02:00
parent eb94ddf1a4
commit 0c39fdcf84
4 changed files with 77 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
redis-impl.scm
View file

@ -1,5 +1,6 @@
;; [[file:redis.org::*API][API:2]] ;; [[file:redis.org::*API][API:2]]
(import (chicken base) (import r7rs
(chicken base)
(chicken port) (chicken port)
(chicken io) (chicken io)
(chicken tcp) (chicken tcp)
@ -73,7 +74,7 @@
(let ((in (redis-connection-input rconn)) (let ((in (redis-connection-input rconn))
(out (redis-connection-output rconn))) (out (redis-connection-output rconn)))
(with-output-to-port out (with-output-to-port out
(lambda () (apply proc args))) (cut apply proc args))
(redis-read-reply in))) (redis-read-reply in)))
;; Running Commands:2 ends here ;; Running Commands:2 ends here
@ -319,9 +320,10 @@
;; #+RESULTS: ;; #+RESULTS:
;; : -- testing Maps -------------------------------------------------------------- ;; : -- testing Maps --------------------------------------------------------------
;; : %2+first:1+second:2 .................................................. [ PASS] ;; : (hash-table-ref ht "first") .......................................... [ PASS]
;; : 1 test completed in 0.0 seconds. ;; : (hash-table-ref ht "second") ......................................... [ PASS]
;; : 1 out of 1 (100%) test passed. ;; : 2 tests completed in 0.001 seconds.
;; : 2 out of 2 (100%) tests passed.
;; : -- done testing Maps --------------------------------------------------------- ;; : -- done testing Maps ---------------------------------------------------------
;; *** Sets ;; *** Sets

2
redis.egg
View file

@ -5,7 +5,7 @@
(category db) (category db)
(license "BSD") (license "BSD")
(version "0.5") (version "0.5")
(dependencies srfi-34 srfi-35 srfi-69 srfi-99 srfi-113 srfi-128 srfi-133 srfi-152 srfi-158) (dependencies r7rs srfi-34 srfi-35 srfi-69 srfi-99 srfi-113 srfi-128 srfi-133 srfi-152 srfi-158)
(test-dependencies test) (test-dependencies test)
(components (components

63
redis.org
View file

@ -18,8 +18,10 @@
** Prepare in-line testing ** Prepare in-line testing
#+name: prep-test #+name: prep-test
#+begin_src scheme :noweb yes :results silent #+begin_src scheme :noweb yes :tangle tests/run.scm :results silent
(import test (import r7rs
test
(chicken base)
(chicken port) (chicken port)
(chicken io) (chicken io)
<<dependencies-for-imports()>> <<dependencies-for-imports()>>
@ -77,14 +79,27 @@
#+end_src #+end_src
#+begin_src scheme :noweb yes :tangle redis-impl.scm :exports none #+begin_src scheme :noweb yes :tangle redis-impl.scm :exports none
(import (chicken base) (import r7rs
(chicken base)
(chicken port) (chicken port)
(chicken io) (chicken io)
(chicken tcp) (chicken tcp)
<<dependencies-for-imports()>> (srfi 34) ;; Exception Handling
(srfi 35) ;; Exception Types
(srfi 69) ;; Hash Tables
(srfi 99) ;; Extended Records
(srfi 113) ;; Sets and Bags
(srfi 128) ;; Comparators
(srfi 133) ;; Vectors
(srfi 152) ;; Strings
(srfi 158) ;; Generators and Accumulators
) )
#+end_src #+end_src
#+begin_src scheme :tangle tests/run.scm :exports none
(include-relative "../redis-impl.scm")
#+end_src
** Exceptions ** Exceptions
This library defines an SRFI-35 exception type ~&redis-error~ that gets raised when Redis returns an error. The exception type has a single field called ~redis-error-message~ containing the error message returned by Redis. This library defines an SRFI-35 exception type ~&redis-error~ that gets raised when Redis returns an error. The exception type has a single field called ~redis-error-message~ containing the error message returned by Redis.
#+begin_src scheme :tangle redis-impl.scm #+begin_src scheme :tangle redis-impl.scm
@ -134,7 +149,7 @@ Calls =proc= with the output port of the =rconn= as current output port, optiona
(let ((in (redis-connection-input rconn)) (let ((in (redis-connection-input rconn))
(out (redis-connection-output rconn))) (out (redis-connection-output rconn)))
(with-output-to-port out (with-output-to-port out
(lambda () (apply proc args))) (cut apply proc args))
(redis-read-reply in))) (redis-read-reply in)))
#+end_src #+end_src
@ -181,7 +196,7 @@ Simple strings start with ~+~ and are single-line.
#+end_src #+end_src
#+name: simple-string-test #+name: simple-string-test
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-simple-string>> <<read-redis-simple-string>>
(test-group "Simple strings" (test-group "Simple strings"
@ -225,7 +240,7 @@ chicken
str)) str))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-blob-string>> <<read-redis-blob-string>>
(test-group "Blob strings" (test-group "Blob strings"
@ -275,7 +290,7 @@ Integers are sent to the client prefixed with ~:~.
(string->number elem)))) (string->number elem))))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-number>> <<read-redis-number>>
(test-group "Integers" (test-group "Integers"
@ -304,7 +319,7 @@ Bignums are prefixed with ~(~.
(3492890328409238509324850943850943825024385 (3492890328409238509324850943850943825024385
#+end_example #+end_example
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-number>> <<read-redis-number>>
(test-group "Bignums" (test-group "Bignums"
@ -329,7 +344,7 @@ True and false values are represented as ~#t~ and ~#f~, just like in Scheme.
(string=? (read-line port) "t"))) (string=? (read-line port) "t")))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-bool>> <<read-redis-bool>>
(test-group "Booleans" (test-group "Booleans"
@ -357,7 +372,7 @@ The null type is encoded simply as ~_~, and results in ~'()~.
(read-line port) '())) (read-line port) '()))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<read-redis-null>> <<read-redis-null>>
(test-group "Null" (test-group "Null"
@ -395,7 +410,7 @@ Arrays are marked with ~*~ followed by the number of entries, and get returned a
vec)) vec))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<redis-read-reply>> <<redis-read-reply>>
<<read-redis-array>> <<read-redis-array>>
@ -436,24 +451,24 @@ Maps are represented exactly as arrays, but instead of using the ~*~ byte, the e
ht)) ht))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<redis-read-reply>> <<redis-read-reply>>
<<read-redis-map>> <<read-redis-map>>
<<read-redis-simple-string>> <<read-redis-simple-string>>
<<read-redis-number>> <<read-redis-number>>
(test-group "Maps" (test-group "Maps"
(test "%2+first:1+second:2" '(("first" . 1) (let ((ht (with-input-from-string "2\r\n+first\r\n:1\r\n+second\r\n:2\r\n" read-redis-map)))
("second" . 2)) (test 1 (hash-table-ref ht "first"))
(hash-table->alist (test 2 (hash-table-ref ht "second"))))
(with-input-from-string "2\r\n+first\r\n:1\r\n+second\r\n:2\r\n" read-redis-map))))
#+end_src #+end_src
#+RESULTS: #+RESULTS:
: -- testing Maps -------------------------------------------------------------- : -- testing Maps --------------------------------------------------------------
: %2+first:1+second:2 .................................................. [ PASS] : (hash-table-ref ht "first") .......................................... [ PASS]
: 1 test completed in 0.0 seconds. : (hash-table-ref ht "second") ......................................... [ PASS]
: 1 out of 1 (100%) test passed. : 2 tests completed in 0.001 seconds.
: 2 out of 2 (100%) tests passed.
: -- done testing Maps --------------------------------------------------------- : -- done testing Maps ---------------------------------------------------------
*** Sets *** Sets
@ -488,7 +503,7 @@ Additionally, there is a parameter defined, =redis-set-comparator=, that specifi
s)) s))
#+end_src #+end_src
#+begin_src scheme :tangle test/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
<<prep-test>> <<prep-test>>
<<redis-read-reply>> <<redis-read-reply>>
<<read-redis-simple-string>> <<read-redis-simple-string>>
@ -529,7 +544,7 @@ This library returns two values in this case, the first value being the actual d
(category db) (category db)
(license "BSD") (license "BSD")
(version <<latest-release()>>) (version <<latest-release()>>)
(dependencies <<dependencies-for-egg()>>) (dependencies r7rs <<dependencies-for-egg()>>)
(test-dependencies test) (test-dependencies test)
(components (components
@ -537,6 +552,10 @@ This library returns two values in this case, the first value being the actual d
(csc-options "-X" "r7rs" "-R" "r7rs" "-sJ")))) (csc-options "-X" "r7rs" "-R" "r7rs" "-sJ"))))
#+end_src #+end_src
#+begin_src scheme :tangle tests/run.scm :exports none
(test-exit)
#+end_src
** Source ** Source
The source is available at [[https://gitea.lyrion.ch/zilti/redis.git]]. The source is available at [[https://gitea.lyrion.ch/zilti/redis.git]].

32
test/run.scm → tests/run.scm
View file

@ -1,3 +1,24 @@
(import (chicken string))
(import r7rs
test
(chicken base)
(chicken port)
(chicken io)
(srfi 34) ;; Exception Handling
(srfi 35) ;; Exception Types
(srfi 69) ;; Hash Tables
(srfi 99) ;; Extended Records
(srfi 113) ;; Sets and Bags
(srfi 128) ;; Comparators
(srfi 133) ;; Vectors
(srfi 152) ;; Strings
(srfi 158) ;; Generators and Accumulators
)
;; [[file:../redis.org::*API][API:3]]
(include-relative "../redis-impl.scm")
;; API:3 ends here
;; #+name: simple-string-test ;; #+name: simple-string-test
@ -58,10 +79,9 @@
;; [[file:../redis.org::*Maps][Maps:2]] ;; [[file:../redis.org::*Maps][Maps:2]]
(test-group "Maps" (test-group "Maps"
(test "%2+first:1+second:2" '(("first" . 1) (let ((ht (with-input-from-string "2\r\n+first\r\n:1\r\n+second\r\n:2\r\n" read-redis-map)))
("second" . 2)) (test 1 (hash-table-ref ht "first"))
(hash-table->alist (test 2 (hash-table-ref ht "second"))))
(with-input-from-string "2\r\n+first\r\n:1\r\n+second\r\n:2\r\n" read-redis-map))))
;; Maps:2 ends here ;; Maps:2 ends here
;; [[file:../redis.org::*Sets][Sets:2]] ;; [[file:../redis.org::*Sets][Sets:2]]
@ -70,3 +90,7 @@
(set=? (set (redis-set-comparator) "orange" "apple" #t #f) (set=? (set (redis-set-comparator) "orange" "apple" #t #f)
(with-input-from-string "4\r\n+orange\r\n+apple\r\n#t\r\n#f\r\n" read-redis-set)))) (with-input-from-string "4\r\n+orange\r\n+apple\r\n#t\r\n#f\r\n" read-redis-set))))
;; Sets:2 ends here ;; Sets:2 ends here
;; [[file:../redis.org::*About this egg][About this egg:2]]
(test-exit)
;; About this egg:2 ends here