mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source 
Conflicts:
	module/language/tree-il/peval.scm
	module/language/tree-il/primitives.scm
	test-suite/tests/tree-il.test
This commit is contained in:
Andy Wingo 2011-11-09 17:04:44 +01:00
commit 2f4aae6bce
6 changed files with 108 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

26
test-suite/tests/r6rs-lists.test
View file

@ -30,3 +30,29 @@
(let ((d '((3 a) (1 b) (4 c))))
(equal? (assp even? d) '(4 c)))))
(with-test-prefix "fold-left"
(pass-if "fold-left sum"
(equal? (fold-left + 0 '(1 2 3 4 5))
15))
(pass-if "fold-left reverse"
(equal? (fold-left (lambda (a e) (cons e a)) '() '(1 2 3 4 5))
'(5 4 3 2 1)))
(pass-if "fold-left max-length"
(equal? (fold-left (lambda (max-len s)
(max max-len (string-length s)))
0
'("longest" "long" "longer"))
7))
(pass-if "fold-left with-cons"
(equal? (fold-left cons '(q) '(a b c))
'((((q) . a) . b) . c)))
(pass-if "fold-left sum-multiple"
(equal? (fold-left + 0 '(1 2 3) '(4 5 6))
21))
(pass-if "fold-left pairlis"
(equal? (fold-left (lambda (accum e1 e2)
(cons (cons e1 e2) accum))
'((d . 4))
'(a b c)
'(1 2 3))
'((c . 3) (b . 2) (a . 1) (d . 4)))))

18
test-suite/tests/tree-il.test
View file

@ -1461,6 +1461,24 @@
(cdr (list (bar) 0))
(seq (call (toplevel bar)) (primcall list (const 0))))
(pass-if-peval
;; Non-constant guards get lexical bindings.
(dynamic-wind foo (lambda () bar) baz)
(let (pre post) (_ _) ((toplevel foo) (toplevel baz))
(dynwind (lexical pre _) (toplevel bar) (lexical post _))))
(pass-if-peval
;; Constant guards don't need lexical bindings.
(dynamic-wind (lambda () foo) (lambda () bar) (lambda () baz))
(dynwind
(lambda ()
(lambda-case
((() #f #f #f () ()) (toplevel foo))))
(toplevel bar)
(lambda ()
(lambda-case
((() #f #f #f () ()) (toplevel baz))))))
(pass-if-peval
;; Prompt is removed if tag is unreferenced
(let ((tag (make-prompt-tag)))