summaryrefslogtreecommitdiffstats
path: root/tests/012/oop.tl
blob: 51dadbf3c57e80d075974ebdf499130ab3e5420d (plain)
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
(load "../common")

(defstruct animal nil
  (:function whoami () "n/a")
  (:method print (self stream : pretty-p) (put-string self.[whoami] stream)))

(defstruct dog animal
  (:function whoami () "dog"))

(defstruct collie dog
  (:function whoami () "collie"))

(defstruct poodle dog)

(defvarl a (new animal))
(defvarl d (new dog))
(defvarl c (new collie))

(defun print-all ()
  (pprinl a)
  (pprinl d)
  (pprinl c))

(print-all)

(defmeth animal whoami ()
  "animal")

(print-all)

(defmeth dog whoami ()
  "canine")

(print-all)

(defmeth poodle whoami ()
  "poodle")

(print-all)

(pprinl (new poodle))

(mapcar (umeth print *stdout*) (list (new collie) (new dog)))
(put-line)

(let* ((ssl (gun (make-string-output-stream)))
       (s1 (pop ssl))
       (s2 (pop ssl))
       (s3 (pop ssl))
       (d (new collie)))
  [(meth d print s1)]
  [(meth d print s2)]
  [(meth d print s3)]
  (tprint [mapcar get-string-from-stream (list s1 s2 s3)]))

(defstruct b nil
  (:instance a 1)
  (:instance b 2)
  (:instance c 3)
  (:static sa 10)
  (:static sb 20)
  (:static sc 30))

(defstruct d b
  (a)
  (b -2)
  (:static sa)
  (:static sb -20)
  (:static y 0))

(static-slot-ensure 'b 'x 42)
(static-slot-ensure 'b 'y 42)

(let ((b (new b sc 300))
      (d (new d)))
  (prinl b)
  (prinl d)
  (prinl (list b.sa b.sb b.sc b.x b.y))
  (prinl (list d.sa d.sb d.sc d.x d.y)))