diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2009-07-30 00:48:04 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2009-07-31 00:49:22 +0200 |
| commit | f4aa0f104b3347c21093b837046022fb7bb6a2ff (patch) | |
| tree | 3f57381d052766f043deeb74fea118e83306447a /test-suite/tests | |
| parent | 904a78f11d2d11a58d5df365a44c4fbbd4c96df3 (diff) | |
| download | guile-f4aa0f104b3347c21093b837046022fb7bb6a2ff.tar.gz | |
Add `tree-il-fold', a purely functional iterator on `tree-il'.
* module/language/tree-il.scm (tree-il-fold): New procedure.
* test-suite/tests/tree-il.test ("tree-il-fold"): New test prefix.
Diffstat (limited to 'test-suite/tests')
| -rw-r--r-- | test-suite/tests/tree-il.test | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index 6634dcdd7..8b8f1238d 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -467,3 +467,42 @@ (toplevel ref bar) (call call/cc 1) (call goto/args 1)))) + +(with-test-prefix "tree-il-fold" + + (pass-if "empty tree" + (let ((leaf? #f) (up? #f) (down? #f) (mark (list 'mark))) + (and (eq? mark + (tree-il-fold (lambda (x y) (set! leaf? #t) y) + (lambda (x y) (set! down? #t) y) + (lambda (x y) (set! up? #t) y) + mark + '())) + (not leaf?) + (not up?) + (not down?)))) + + (pass-if "lambda and application" + (let* ((leaves '()) (ups '()) (downs '()) + (result (tree-il-fold (lambda (x y) + (set! leaves (cons x leaves)) + (1+ y)) + (lambda (x y) + (set! downs (cons x downs)) + (1+ y)) + (lambda (x y) + (set! ups (cons x ups)) + (1+ y)) + 0 + (parse-tree-il + '(lambda (x y) (x1 y1) + (apply (toplevel +) + (lexical x x1) + (lexical y y1))))))) + (and (equal? (map strip-source leaves) + (list (make-lexical-ref #f 'y 'y1) + (make-lexical-ref #f 'x 'x1) + (make-toplevel-ref #f '+))) + (= (length downs) 2) + (equal? (reverse (map strip-source ups)) + (map strip-source downs)))))) |