diff options
author | jao <jao@gnu.org> | 2020-07-20 18:57:35 +0100 |
---|---|---|
committer | jao <jao@gnu.org> | 2020-07-20 18:57:35 +0100 |
commit | 94296d8dcfb46812bb142e4fb6a41e9bc810d287 (patch) | |
tree | 07e6a73926708fb06fdfa0ad3cbf17c8141ced52 /scheme/chez/geiser/test.ss | |
parent | 9d66c63c5374001608b2e1807c3e136c82c44f60 (diff) | |
download | geiser-chez-94296d8dcfb46812bb142e4fb6a41e9bc810d287.tar.gz geiser-chez-94296d8dcfb46812bb142e4fb6a41e9bc810d287.tar.bz2 |
files moved from original import locations
Diffstat (limited to 'scheme/chez/geiser/test.ss')
-rw-r--r-- | scheme/chez/geiser/test.ss | 120 |
1 files changed, 0 insertions, 120 deletions
diff --git a/scheme/chez/geiser/test.ss b/scheme/chez/geiser/test.ss deleted file mode 100644 index 2407448..0000000 --- a/scheme/chez/geiser/test.ss +++ /dev/null @@ -1,120 +0,0 @@ -(import (geiser) - (chezscheme)) - -(define-syntax assert-equal - (syntax-rules () - ((_ a b) - (if (equal? a b) - #t - (begin - (display (format "failed assertion `~a' == `~a'" a b)) - (assert (equal? a b))))))) - -(define-syntax get-result - (syntax-rules () - ((_ form) - (with-output-to-string - (lambda () - (geiser:eval #f form)))))) - -(define-syntax do-test - (syntax-rules () - ((_ form result) - (assert - (equal? - (get-result form) - result))))) - -(define-syntax do-test-macroexpand - (syntax-rules () - ((_ form result) - (assert - (equal? (geiser:macroexpand form) - result))))) - -(define-syntax test-or - (syntax-rules () - ((_ x) x) - ((_ x xs ...) - (if x - x - (test-or xs ...))))) - -(do-test-macroexpand - '(test-or 1) - '1) - -(do-test-macroexpand - '(test-or 1 2) - '(if 1 1 2)) - -;; (something-doesnot-exist) -;;=> Error: Exception: variable something-doesnot-exist is not bound -(do-test - '(something-doesnot-exist) - "((result \"\") (output . \"\") (error (key . \"Exception: variable something-doesnot-exist is not bound\")))\n" - ) - -;; (make-violation) -;;=> #<condition &violation> -(do-test - '(make-violation) - "((result \"#<condition &violation>\\n\") (output . \"\"))\n") - -;; (values 1 2 3) -;;==> (1 2 3) -(do-test - '(values 1 2 3) - "((result \"(1 2 3)\\n\") (output . \"\"))\n") - -;; 1 -;;=> 1 -(do-test '1 "((result \"1\\n\") (output . \"\"))\n") - - -;; '(case-lambda -;; [(x1 x2) (+ x1 x2)] -;; [(x1 x2 x3) (+ (+ x1 x2) x3)] -;; [(x1 x2 . rest) -;; ((letrec ([loop (lambda (x1 x2 rest) -;; (let ([x (+ x1 x2)]) -;; (if (null? rest) -;; x -;; (loop x (car rest) (cdr rest)))))]) -;; loop) -;; x1 -;; x2 -;; rest)] -;; [(x1) (+ x1)] -;; [() (+)]) -#|=> (case-lambda - [(x1 x2) (+ x1 x2)] - [(x1 x2 x3) (+ (+ x1 x2) x3)] - [(x1 x2 . rest) - ((letrec ([loop (lambda (x1 x2 rest) - (let ([x (+ x1 x2)]) - (if (null? rest) - x - (loop x (car rest) (cdr rest)))))]) - loop) - x1 - x2 - rest)] - [(x1) (+ x1)] - [() (+)]) - |# -(do-test (quote '(case-lambda - [(x1 x2) (+ x1 x2)] - [(x1 x2 x3) (+ (+ x1 x2) x3)] - [(x1 x2 . rest) - ((letrec ([loop (lambda (x1 x2 rest) - (let ([x (+ x1 x2)]) - (if (null? rest) - x - (loop x (car rest) (cdr rest)))))]) - loop) - x1 - x2 - rest)] - [(x1) (+ x1)] - [() (+)])) "((result \"(case-lambda\\n [(x1 x2) (+ x1 x2)]\\n [(x1 x2 x3) (+ (+ x1 x2) x3)]\\n [(x1 x2 . rest)\\n ((letrec ([loop (lambda (x1 x2 rest)\\n (let ([x (+ x1 x2)])\\n (if (null? rest)\\n x\\n (loop x (car rest) (cdr rest)))))])\\n loop)\\n x1\\n x2\\n rest)]\\n [(x1) (+ x1)]\\n [() (+)])\\n\") (output . \"\"))\n") |