tests/012/oop-seq.tl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

(load "../common")

(defstruct counter-iter-fast ()
  cur-val
  step
  limit
  (:method iter-item (me)
    me.cur-val)
  (:method iter-step (me)
    (inc me.cur-val me.step)
    (if (< me.cur-val me.limit) me)))

(defstruct counter-fast ()
  init
  step
  limit
  (:method iter-begin (me)
    (if (< me.init me.limit)
      (new counter-iter-fast
           cur-val me.init
           step me.step
           limit me.limit))))

(defstruct counter-iter-canon ()
  cur-val
  step
  limit
  (:method iter-item (me)
    me.cur-val)
  (:method iter-more (me)
    (< me.cur-val me.limit))
  (:method iter-step (me)
    (inc me.cur-val me.step)
    me))

(defstruct counter-canon ()
  init
  step
  limit
  (:method iter-begin (me)
    (new counter-iter-canon
         cur-val me.init
         step me.step
         limit me.limit)))

(test (list-seq (new counter-canon init 0 step 2 limit 10))
      (0 2 4 6 8))

(test (list-seq (new counter-fast init 0 step 2 limit 10))
      (0 2 4 6 8))

(test (list-seq (new counter-canon init 0 step 1 limit 0))
      nil)

(test (list-seq (new counter-fast init 0 step 1 limit 0))
      nil)

(defstruct integers ()
  item to next
  (:method length-< (me len)
    (cond
      ((<= len 1) nil)
      (me.next me.next.(length-< (pred len)))
      (t)))
  (:postinit (me)
    (if (< me.item me.to)
      (set me.next (lnew integers to me.to item (succ me.item))))))

(let ((ints (new integers item 1 to 10)))
  (mtest
    (length-< ints 11) t
    (length-< ints 10) nil
    (length-< ints 9) nil))

(test
  (copy-iter (new counter-iter-fast)) :error)

(defstruct copyable-iter ()
  (stamp 0)
  (:method copy (me)
    (new copyable-iter stamp (succ me.stamp))))

(let* ((c0 (new copyable-iter stamp 42))
       (c1 (copy-iter c0)))
  (vtest c0.stamp 42)
  (vtest c1.stamp 43))

;; The following reproduced a segfault when the change was made to allow del to
;; work with structs that have lambda and lambda-set.

(defstruct blah ()
  (:method lambda-set (me . args)))

(defparm o (new blah))

(set [o 1..20] 42)

(defmeth blah lambda (me . args))

(set [o 1..20] 42)