Changeset 33777 in project for release/4/bindings/trunk/tests/run.scm
 Timestamp:
 12/30/16 19:12:47 (3 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/bindings/trunk/tests/run.scm
r33533 r33777 3 3 ;;;; ju (at) jugilo (dot) de 4 4 5 (requirelibrary bindings arrays basicsequences simpletests) 5 (requirelibrary bindings arrays basicsequences simpletests 6 simpleexceptions) 6 7 7 8 (import simpletests 8 bindings 9 (only basicsequences seqdb)9 bindings basicsequences simpleexceptions 10 ;(only basicsequences seqdb) 10 11 (only arrays array array? arrayref arraytail array>list) 11 12 ) … … 481 482 )) 482 483 484 (definetest (types?) 485 (check 486 "LISTS AS ALGEBRAIC TYPE" 487 (definealgebraictype LIST List? (Nil) (Cons (x) (xs List?))) 488 (define (List>list lst) 489 (bindcase (<< lst List?) 490 ((#:Nil) '()) 491 ((#:Cons x xs) 492 (cons x (List>list xs))))) 493 (define three (Cons 0 (Cons 1 (Cons 2 (Nil))))) 494 (equal? (List>list three) '(0 1 2)) 495 496 "TYPED VECTORS AS ALGEBRAIC TYPE" 497 (definealgebraictype VEC Vec? (Vec (x integer?) xs integer?)) 498 (define (Vec>list vec) 499 (bind (#:Vec x . xs) (<< vec Vec?) 500 (cons x (vector>list (subvector xs 1))))) 501 (define four (Vec 0 1 2 3)) 502 (equal? (Vec>list four) '(0 1 2 3)) 503 504 "TYPED TREES AS ALGEBRAIC TYPE" 505 (definealgebraictype TREE Tree? 506 (Leaf (b number?)) 507 (Node (left Tree?) (t number?) (right Tree?))) 508 (define (leafsum tr) 509 (bindcase (<< tr Tree?) 510 ((#:Leaf b) b) 511 ((#:Node left middle right) 512 (+ (leafsum left) middle (leafsum right))))) 513 (define tree (Node (Leaf 1) 2 (Leaf 3))) 514 (= (leafsum tree) 6) 515 )) 516 517 483 518 (compoundtest (BINDINGS) 484 519 (binds?) … … 488 523 (lets?) 489 524 (defines?) 525 (types?) 490 526 ) 491 527
Note: See TracChangeset
for help on using the changeset viewer.