Added the SRFI tests. (I accidentally removed them)

pkgfile

@@ -1,8 +1,10 @@
 (package
- (version v0.0.1)
+ (version v0.0.2)
  (maintainer "Per Eckerdal <per dot eckerdal at gmail dot com>")
  (author "Several")
  (homepage "http://github.com/pereckerdal/srfi")
  (description "A collection of SRFI implementations")
  (keywords srfi util)
- (license various))
+ (license various)
+
+ (source-directory "src"))

tests/and-let.scm

@@ -0,0 +1,43 @@
+(import (srfi tests and-let))
+
+(test-begin "srfi-2" 31)
+
+(test-equal  (and-let* () 1) 1)
+(test-equal  (and-let* () 1 2) 2)
+(test-equal  (and-let* () ) #t)
+
+(test-equal (let ((x #f)) (and-let* (x))) #f)
+(test-equal (let ((x 1)) (and-let* (x))) 1)
+(test-equal (and-let* ((x #f)) ) #f)
+(test-equal (and-let* ((x 1)) ) 1)
+(test-equal (and-let* ( (#f) (x 1)) ) #f)
+(test-equal (and-let* ( (2) (x 1)) ) 1)
+(test-equal (and-let* ( (x 1) (2)) ) 2)
+(test-equal (let ((x #f)) (and-let* (x) x)) #f)
+(test-equal (let ((x "")) (and-let* (x) x)) "")
+(test-equal (let ((x "")) (and-let* (x)  )) "")
+(test-equal (let ((x 1)) (and-let* (x) (+ x 1))) 2)
+(test-equal (let ((x #f)) (and-let* (x) (+ x 1))) #f)
+(test-equal (let ((x 1)) (and-let* (((positive? x))) (+ x 1))) 2)
+(test-equal (let ((x 1)) (and-let* (((positive? x))) )) #t)
+(test-equal (let ((x 0)) (and-let* (((positive? x))) (+ x 1))) #f)
+(test-equal (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1)))  3)
+
+(test-equal (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))) 2)
+(test-equal (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) 2)
+(test-equal (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))) #f)
+(test-equal (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))) #f)
+(test-equal (let ((x #f)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) #f)
+
+(test-equal  (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
+(test-equal  (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
+(test-equal  (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
+(test-equal  (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) 3/2)
+
+(test-error (test-read-eval-string "(and-let* ( #f (x 1)))"))
+(test-error (test-read-eval-string "(and-let* (2 (x 1)))"))
+(test-error
+  (test-read-eval-string
+    "(let ((x 1)) (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))"))
+
+(test-end "srfi-2")

tests/cond.scm

@@ -0,0 +1,34 @@
+(import (srfi tests cond))
+
+(test-begin "srfi-61")
+
+(define this-file "61.scm")
+
+(test-assert #t) ; Bug in srfi-64? Test must start with an assert
+
+;; From SRFI-61 document
+(define (port->char-list-r5rs port)
+  (cond
+    ((read-char port) char?
+     => (lambda (c) (cons c (port->char-list-r5rs port))))
+    (else '())))
+
+(test-error "r5rs-cond"
+  (test-read-eval-string
+    "(port->char-list-r5rs (open-input-file this-file))"))
+
+(import ../61)
+
+(define (port->char-list-srfi port)
+  (cond
+    ((read-char port) char?
+     => (lambda (c) (cons c (port->char-list-srfi port))))
+    (else '())))
+
+;; Tests that it actually expands properly when this srfi is loaded
+
+(test-assert "srfi-cond"
+  (test-read-eval-string
+    "(port->char-list-srfi (open-input-file this-file))"))
+
+(test-end "srfi-61")

tests/hash-tables.scm

@@ -0,0 +1,44 @@
+(import (srfi tests hash-tables))
+(import ../69)
+
+(test-begin "srfi-69" 5)
+
+(let ((ht (make-hash-table)))
+  (hash-table-set! ht 0 'element)
+
+  (test-equal
+    (hash-table-ref ht 0 (lambda () #f))
+    'element)
+
+  (hash-table-update! ht 
+                      0
+                      (lambda (x) 'updated))
+
+  (test-equal
+    (hash-table-ref ht 0 (lambda () #f))
+    'updated)
+
+  (hash-table-delete! ht 0)
+  (test-error
+    (hash-table-ref ht 0)))
+
+
+(let* ((al `((a "uno")
+             (b "dos")
+             (c "tres")
+             (d "cuatro")
+             (e "cinco")
+             (f "seis")))
+       (ht (alist->hash-table al equal?)))
+
+  (test-equal
+    (car (hash-table-ref ht 'e))
+    "cinco")
+
+  (hash-table-set! ht 'e "five")
+
+  (test-equal
+    (hash-table-ref ht 'e)
+    "five"))
+
+(test-end "srfi-69")

tests/let-values.scm

@@ -0,0 +1,25 @@
+(import (srfi tests let-values))
+
+(test-begin "srfi-11" 3)
+
+(test-equal
+ (let-values (((a b) (values 1 2))
+              ((c d) (values 3 4)))
+   (list a b c d))
+ (list 1 2 3 4))
+
+(test-equal
+ (let ((a 'a)
+       (b 'b))
+   (let-values (((a b) (values 1 2))
+                ((c d e) (values a b 3)))
+     (list a b c d e)))
+ (list 1 2 'a 'b 3))
+
+(test-equal
+ (let*-values (((a b) (values 1 2))
+               ((c d e) (values a b 3)))
+   (list a b c d e))
+ (list 1 2 1 2 3))
+
+(test-end "srfi-11")

tests/specialize-procedures.scm

@@ -0,0 +1,47 @@
+; Sebastian.Egner@philips.com, 3-Jun-2002.
+;; 
+;; Adapted to Blackhole for Gambit by Álvaro Castro-Castilla
+;; Uses srfi-64 for testing
+
+(import (srfi tests))
+(import (srfi specialize-procedures))
+
+(test-begin "srfi-26" 25)
+
+(test-equal ((cut list)) '())
+(test-equal ((cut list <...>)) '())
+(test-equal ((cut list 1)) '(1))
+(test-equal ((cut list <>) 1) '(1))
+(test-equal ((cut list <...>) 1) '(1))
+(test-equal ((cut list 1 2)) '(1 2))
+(test-equal ((cut list 1 <>) 2) '(1 2))
+(test-equal ((cut list 1 <...>) 2) '(1 2))
+(test-equal ((cut list 1 <...>) 2 3 4) '(1 2 3 4))
+(test-equal ((cut list 1 <> 3 <>) 2 4) '(1 2 3 4))
+(test-equal ((cut list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6))
+(test-equal (let* ((x 'wrong) (y (cut list x))) (set! x 'ok) (y)) '(ok))
+(test-equal 
+  (let ((a 0))
+    (map (cut + (begin (set! a (+ a 1)) a) <>)
+         '(1 2))
+    a)
+  2)
+(test-equal ((cute list)) '())
+(test-equal ((cute list <...>)) '())
+(test-equal ((cute list 1)) '(1))
+(test-equal ((cute list <>) 1) '(1))
+(test-equal ((cute list <...>) 1) '(1))
+(test-equal ((cute list 1 2)) '(1 2))
+(test-equal ((cute list 1 <>) 2) '(1 2))
+(test-equal ((cute list 1 <...>) 2) '(1 2))
+(test-equal ((cute list 1 <...>) 2 3 4) '(1 2 3 4))
+(test-equal ((cute list 1 <> 3 <>) 2 4) '(1 2 3 4))
+(test-equal ((cute list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6))
+(test-equal 
+  (let ((a 0))
+    (map (cute + (begin (set! a (+ a 1)) a) <>)
+         '(1 2))
+    a)
+  1)
+
+(test-end "srfi-26")

tests/tests.scm

@@ -0,0 +1,15 @@
+(import (srfi tests))
+
+(define my-simple-runner (test-runner-simple))
+(test-runner-factory
+  (lambda () my-simple-runner))
+
+(test-begin "simple-runner")
+
+(test-assert #t)
+(test-equal 0 0)
+(test-approximate 0.01 0.02 0.1)
+(test-error (error "error"))
+;(test-error #t) ; This is commented because it should fail!
+
+(test-end "simple-runner")