klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

encapsulations.k (1572B)

      1 ;; check.k & test-helpers.k should be loaded
      2 ;;
      3 ;; Tests of encapsulation features.
      4 ;;
      5 
      6 ;; 8.1.1 make-encapsulation-type
      7 
      8 ($let* (((e1 p1? d1) (make-encapsulation-type))
      9         ((e2 p2? d2) (make-encapsulation-type))
     10         (v1 "test")
     11         (v2 (list 1 2 3))
     12         (r11 (e1 v1))
     13         (r12 (e1 v2))
     14         (r21 (e2 v1))
     15         (r22 (e2 v2))
     16         (r11* (e1 v1)))
     17   ($check-not-predicate (equal? e1 e2))
     18   ($check-not-predicate (equal? p1? p2?))
     19   ($check-not-predicate (equal? d1 d2))
     20 
     21   ($check-not-predicate (p1? v1))
     22   ($check-not-predicate (p1? v2))
     23   ($check-not-predicate (p1? e1))
     24   ($check-not-predicate (p1? p1?))
     25   ($check-not-predicate (p1? d2))
     26   ($check-not-predicate (p1? 0))
     27   ($check-not-predicate (p1? #f))
     28   ($check-not-predicate (p1? #\x))
     29   ($check-not-predicate (p1? (make-encapsulation-type)))
     30 
     31   ($check-not-predicate (eq? r11 r12))
     32   ($check-not-predicate (eq? r11 r21))
     33   ($check-not-predicate (eq? r11 r22))
     34   ($check-not-predicate (eq? r11 r11*))
     35 
     36   ($check-not-predicate (equal? r11 r12))
     37   ($check-not-predicate (equal? r11 r21))
     38   ($check-not-predicate (equal? r11 r22))
     39   ($check-not-predicate (equal? r11 r11*))
     40 
     41   ($check-predicate (p1?))
     42   ($check-predicate (p1? r11))
     43 
     44   ($check-predicate (p1? r11 r12))
     45   ($check-predicate (p2? r21 r22))
     46   ($check-not-predicate (p1? r21))
     47   ($check-not-predicate (p2? r11))
     48 
     49   ($check eq? (d1 r11) v1)
     50   ($check eq? (d1 r12) v2)
     51   ($check eq? (d2 r21) v1)
     52   ($check eq? (d2 r22) v2)
     53 
     54   ($check-error (d1 r21))
     55   ($check-error (d1 r22))
     56   ($check-error (d2 r11))
     57   ($check-error (d2 r12)))