nendo 0.5.0 → 0.5.1

data/test/match-test.nnd

@@ -0,0 +1,186 @@
+;;-*- mode: nendo; syntax: scheme -*-;;
+;;
+;; match-test.nnd - test suite for util.match
+;;  
+;;   This file ported from chibi-scheme 0.3 by Alex Shinn.
+;;
+
+(use nendo.test)
+(use util.match)
+;;(use util.match-expanded)
+
+(test-start "match")
+(test-section "match")
+
+(define-syntax match-test*
+  (syntax-rules ()
+    ((_ title code result)
+     (test* title result code))))
+
+(define-syntax pending*
+  (syntax-rules ()
+    ((_ title code result)
+     (printf "(pending) [%s]\n" title))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; run tests
+(match-test* "any" (match 'any (_ 'ok)) 'ok)
+(match-test* "symbol" (match 'ok (x x)) 'ok)
+(match-test* "number" (match 28 (28 'ok)) 'ok)
+(match-test* "string" (match "good" ("bad" 'fail) ("good" 'ok)) 'ok)
+(match-test* "literal symbol" (match 'good ('bad 'fail) ('good 'ok)) 'ok)
+(match-test* "null" (match '() (() 'ok)) 'ok)
+(match-test* "pair" (match '(ok) ((x) x)) 'ok)
+(match-test* "vector" (match '#(ok) (#(x) x)) 'ok)
+(match-test* "any doubled" (match '(1 2) ((_ _) 'ok)) 'ok)
+(match-test* "and empty" (match '(o k) ((and) 'ok)) 'ok)
+(match-test* "and single" (match 'ok ((and x) x)) 'ok)
+(match-test* "and double" (match 'ok ((and (? symbol?) y) 'ok)) 'ok)
+(match-test* "or empty" (match '(o k) ((or) 'fail) (else 'ok)) 'ok)
+(match-test* "or single" (match 'ok ((or x) 'ok)) 'ok)
+(match-test* "or double" (match 'ok ((or (? symbol? y) y) y)) 'ok)
+(match-test* "not" (match 28 ((not (a . b)) 'ok)) 'ok)
+(match-test* "pred" (match 28 ((? number?) 'ok)) 'ok)
+(match-test* "named pred" (match 28 ((? number? x) (+ x 1))) 29)
+(match-test* "duplicate symbols pass" (match '(ok . ok) ((x . x) x)) 'ok)
+(match-test* "duplicate symbols fail" (match '(ok . bad) ((x . x) 'bad) (else 'ok)) 'ok)
+(match-test* "duplicate symbols samth" (match '(ok . ok) ((x . 'bad) x) (('ok . x) x)) 'ok)
+
+(match-test* "ellipses"
+            (match '((a . 1) (b . 2) (c . 3))
+              (((x . y) ___) (list x y)))
+            '((a b c) (1 2 3)))
+
+(match-test* "real ellipses"
+            (match '((a . 1) (b . 2) (c . 3))
+              (((x . y) ...) (list x y)))
+            '((a b c) (1 2 3)))
+
+(match-test* "vector ellipses"
+            (match '#(1 2 3 (a . 1) (b . 2) (c . 3))
+              (#(a b c (hd . tl) ...) (list a b c hd tl)))
+            '(1 2 3 (a b c) (1 2 3)))
+
+(match-test* "pred ellipses"
+            (match '(1 2 3)
+              (((? odd? n) ___) n)
+              (((? number? n) ___) n))
+            '(1 2 3))
+
+(match-test* "failure continuation"
+            (match '(1 2)
+              ((a . b) (=> next) (if (even? a) 'fail (next)))
+              ((a . b) 'ok))
+            'ok)
+
+(match-test* "let"
+            (match-let ((x 'ok) (y '(o k)))
+              y)
+            '(o k))
+
+(match-test* "let*"
+            (match-let* ((x 'f) (y 'o) ((z w) (list y x)))
+              (list x y z w))
+            '(f o o f))
+
+(match-test* "getter car"
+            (match '(1 . 2) (((get! a) . b) (list (a) b)))
+            '(1 2))
+
+(match-test* "getter cdr"
+            (match '(1 . 2) ((a . (get! b)) (list a (b))))
+            '(1 2))
+
+(match-test* "getter vector"
+            (match '#(1 2 3) (#((get! a) b c) (list (a) b c)))
+            '(1 2 3))
+
+(match-test* "setter car"
+            (let ((x (cons 1 2)))
+              (match x (((set! a) . b) (a 3)))
+              x)
+            '(3 . 2))
+
+(match-test* "setter cdr"
+            (let ((x (cons 1 2)))
+              (match x ((a . (set! b)) (b 3)))
+              x)
+            '(1 . 3))
+
+(match-test* "setter vector"
+            (let ((x (vector 1 2 3)))
+              (match x (#(a (set! b) c) (b 0)))
+              x)
+            '#(1 0 3))
+
+(match-test* "single tail"
+            (match '((a . 1) (b . 2) (c . 3))
+              (((x . y) ... last) (list x y last)))
+            '((a b) (1 2) (c . 3)))
+
+(match-test* "single tail 2"
+            (match '((a . 1) (b . 2) 3)
+              (((x . y) ... last) (list x y last)))
+            '((a b) (1 2) 3))
+
+(match-test* "multiple tail"
+            (match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5))
+              (((x . y) ... u v w) (list x y u v w)))
+            '((a b) (1 2) (c . 3) (d . 4) (e . 5)))
+
+(match-test* "Riastradh quasiquote"
+            (match '(1 2 3) (`(1 ,b ,c) (list b c)))
+            '(2 3))
+
+(match-test* "trivial tree search"
+            (match '(1 2 3) ((_ *** (a b c)) (list a b c)))
+            '(1 2 3))
+
+(match-test* "simple tree search"
+            (match '(x (1 2 3)) ((_ *** (a b c)) (list a b c)))
+            '(1 2 3))
+
+(match-test* "deep tree search"
+            (match '(x (x (x (1 2 3)))) ((_ *** (a b c)) (list a b c)))
+            '(1 2 3))
+
+(match-test* "non-tail tree search"
+            (match '(x (x (x a b c (1 2 3) d e f))) ((_ *** (a b c)) (list a b c)))
+            '(1 2 3))
+
+(match-test* "restricted tree search"
+            (match '(x (x (x a b c (1 2 3) d e f))) (('x *** (a b c)) (list a b c)))
+            '(1 2 3))
+
+(match-test* "fail restricted tree search"
+            (match '(x (y (x a b c (1 2 3) d e f)))
+              (('x *** (a b c)) (list a b c))
+              (else #f))
+            #f)
+
+;; /home2/home/kiyoka/work/github/nendo/lib/nendo.rb:2317: stack level too deep (SystemStackError)
+(match-test* "sxml tree search"
+    (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+      (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
+       (list attrs text))
+      (else #f))
+  '(((href . "http://synthcode.com/")) ("synthcode")))
+
+;; /home2/home/kiyoka/work/github/nendo/lib/nendo.rb:2317: stack level too deep (SystemStackError)
+(match-test*  "failed sxml tree search"
+    (match '(p (ol (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+      (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...))
+       (list attrs text))
+      (else #f))
+  #f)
+
+;; ./test/match-test.nnd:192: Error: undefined variable _tag (NameError)
+(match-test* "collect tree search"
+    (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f)))
+      (((and tag (or 'p 'ul 'li 'b)) *** ('a ('^ attrs ...) text ...))
+       (list tag attrs text))
+      (else #f))
+  '((p ul li) ((href . "http://synthcode.com/")) ("synthcode")))
+
+(test-end)

data/test/nendo-util-test.nnd

@@ -40,13 +40,11 @@
  (let1 var
   (+ arg1 1) var))
  expanded: 
-(define
- (' dummy-function)
+(define dummy-function
  (lambda
-  ('
-   (arg1))
-  (let
-   (((' var)
+  (arg1)
+  (%let
+   ((var
      (+ arg1 1))) var)))
 "
        (disasm 'dummy-function 'info))
@@ -54,7 +52,7 @@
        '(define (dummy-function arg1) (let1 var (+ arg1 1) var))
        (disasm 'dummy-function 'source))
 (test* "disasm expanded"
-       '(define 'dummy-function (lambda '(arg1) (let (('var (+ arg1 1))) var)))
+       '(define dummy-function (lambda (arg1) (%let ((var (+ arg1 1))) var)))
        (disasm 'dummy-function 'expanded))
 (test* "disasm ruby-code"
        "