Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss

   1 (require 'clientdata_prop_a)
   2 (require 'clientdata_prop_b)
   3
   4 (define a (make <A>))
   5 (test-A a)
   6 (test-tA a)
   7 (test-t2A a)
   8 (test-t3A a)
   9 (fA a)
  10
  11 (define b (make <B>))
  12 (test-A b)
  13 (test-tA b)
  14 (test-t2A b)
  15 (test-t3A b)
  16 (test-B b)
  17 (fA b)
  18 (fB b)
  19
  20 (define c (make <C>))
  21 (test-A c)
  22 (test-tA c)
  23 (test-t2A c)
  24 (test-t3A c)
  25 (test-C c)
  26 (fA c)
  27 (fC c)
  28
  29 (define d (make <D>))
  30 (test-A d)
  31 (test-tA d)
  32 (test-t2A d)
  33 (test-t3A d)
  34 (test-D d)
  35 (test-tD d)
  36 (test-t2D d)
  37 (fA d)
  38 (fD d)
  39
  40 ;; here are the real tests... if the clientdata is correctly
  41 ;; propegated, new-tA, new-t2A, should all return wrapped proxy's
  42 ;; of class <A>
  43
  44 (define a2 (new-tA))
  45 (if (not (eq? (class-of a2) <A>))
  46   (error "Error 1"))
  47 (test-A a2)
  48 (test-tA a2)
  49 (test-t2A a2)
  50 (test-t3A a2)
  51 (fA a2)
  52
  53 (define a3 (new-t2A))
  54 (if (not (eq? (class-of a3) <A>))
  55   (error "Error 2"))
  56 (test-A a3)
  57 (test-tA a3)
  58 (test-t2A a3)
  59 (test-t3A a3)
  60 (fA a3)
  61
  62 (define a4 (new-t3A))
  63 (if (not (eq? (class-of a4) <A>))
  64   (error "Error 3"))
  65 (test-A a4)
  66 (test-tA a4)
  67 (test-t2A a4)
  68 (test-t3A a4)
  69 (fA a4)
  70
  71 (define d2 (new-tD))
  72 (if (not (eq? (class-of d2) <D>))
  73   (error "Error 4"))
  74 (test-A d2)
  75 (test-tA d2)
  76 (test-t2A d2)
  77 (test-t3A d2)
  78 (test-D d2)
  79 (test-tD d2)
  80 (fA d2)
  81 (fD d2)
  82
  83 (define d3 (new-t2D))
  84 (if (not (eq? (class-of d3) <D>))
  85   (error "Error 5"))
  86 (test-A d3)
  87 (test-tA d3)
  88 (test-t2A d3)
  89 (test-t3A d3)
  90 (test-D d3)
  91 (test-tD d3)
  92 (fA d3)
  93 (fD d3)
  94
  95 (exit 0)