home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / clos.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  5.0 KB  |  320 lines
  1. (use-package "CLOS")
  2. T
  3.  
  4. (unintern '<C1>)
  5. T
  6.  
  7. (progn
  8. (defclass <C1> ()
  9.   ((x :initform 0 :accessor x-val :reader get-x :writer set-x :initarg :x)
  10.    (y :initform 1 :accessor y-val :reader get-y :writer set-y :initarg :y)))
  11. ())
  12. NIL
  13.  
  14. (progn
  15. (defclass <C2> (<C1>)
  16.   ((z :initform 0 :accessor z-val :reader get-z :writer set-z :initarg :z)))
  17. ())
  18. NIL
  19.  
  20. (defparameter a (make-instance (find-class '<C1>) :x 10))
  21. A
  22.  
  23. (x-val a)
  24. 10
  25.  
  26. (y-val a)
  27. 1
  28.  
  29. (setf (x-val a) 20)
  30. 20
  31.  
  32. (x-val a)
  33. 20
  34.  
  35. (get-x a)
  36. 20
  37.  
  38. (set-x 10 a)
  39. 10
  40.  
  41. (x-val a)
  42. 10
  43.  
  44. (defparameter b (make-instance (find-class '<C2>) :x 10 :y 20 :z 30))
  45. B
  46.  
  47. (x-val b)
  48. 10
  49.  
  50. (y-val b)
  51. 20
  52.  
  53. (z-val b)
  54. 30
  55.  
  56. (progn
  57. (defgeneric f (x y)
  58.   (:method ((x t) (y t))
  59.     (list x y)))
  60. (defmethod f ((i integer) (j number))
  61.   (+ i j))
  62. (defmethod f ((s1 string) (s2 string))
  63.     (concatenate 'string s1 s2))
  64. ())
  65. NIL
  66.  
  67. (f t t)
  68. (T T)
  69.  
  70. (f 2 3)
  71. 5
  72.  
  73. (f 2 3.0)
  74. 5.0
  75.  
  76. (f 2.0 3)
  77. (2.0 3)
  78.  
  79. (f "ab" "cd")
  80. "abcd"
  81.  
  82. (f 1 "abc")
  83. (1 "abc")
  84.  
  85. (progn
  86. (defgeneric f (x y)
  87.   (:method ((x t) (y t))
  88.     (list x y))
  89.   (:method ((i number) (j integer))
  90.     (list (call-next-method) (- i j)))
  91.   (:method ((i integer) (j number))
  92.     (list (call-next-method) (+ i j))))
  93. ())
  94. NIL
  95.  
  96. (f 'x 'y)
  97. (X Y)
  98.  
  99. (f 1 2)
  100. (((1 2) -1) 3)
  101.  
  102. (f 1 2.0)
  103. ((1 2.0) 3.0)
  104.  
  105. (f 1.0 2)
  106. ((1.0 2) -1.0)
  107.  
  108. (progn
  109. (defgeneric g (x)
  110.   (:method ((x null))
  111.     (cons 'null (call-next-method)))
  112.   (:method ((x list))
  113.     (if (next-method-p) (cons 'list (call-next-method)) '(list$)))
  114.   (:method ((x symbol))
  115.     (if (next-method-p) (cons 'symbol (call-next-method)) '(symbol$))))
  116. ())
  117. NIL
  118.  
  119. (g 'x)
  120. (SYMBOL$)
  121.  
  122. (g '(x))
  123. (LIST$)
  124.  
  125. (g '())
  126. (NULL SYMBOL LIST$)
  127.  
  128. (defvar hl)
  129. HL
  130.  
  131. (progn
  132. (defgeneric hgen (x)
  133.   (:method ((x integer))
  134.     (setf hl (cons 'i-primary-1 hl))
  135.     (call-next-method)
  136.     (setf hl (cons 'i-primary-2 hl)))
  137.   (:method :before ((x integer))
  138.     (setf hl (cons 'i-before hl)))
  139.   (:method :after ((x integer))
  140.     (setf hl (cons 'i-after hl)))
  141.   (:method :around ((x integer))
  142.     (setf hl (cons 'i-around-1 hl))
  143.     (call-next-method)
  144.     (setf hl (cons 'i-around-2 hl)))
  145.   (:method ((x number))
  146.     (setf hl (cons 'n-primary-1 hl))
  147.     (call-next-method)
  148.     (setf hl (cons 'n-primary-2 hl)))
  149.   (:method :before ((x number))
  150.     (setf hl (cons 'n-before hl)))
  151.   (:method :after ((x number))
  152.     (setf hl (cons 'n-after hl)))
  153.   (:method :around ((x number))
  154.     (setf hl (cons 'n-around-1 hl))
  155.     (call-next-method)
  156.     (setf hl (cons 'n-around-2 hl)))
  157.   (:method ((x t))
  158.     (setf hl (cons 'innermost hl))))
  159. (defun h (x)
  160.   (setf hl '()) (hgen x) (reverse hl))
  161. )
  162. H
  163.  
  164. (h 'abc)
  165. (INNERMOST)
  166.  
  167. (h 3.14)
  168. (N-AROUND-1 N-BEFORE N-PRIMARY-1 INNERMOST N-PRIMARY-2 N-AFTER N-AROUND-2)
  169.  
  170. (h 3)
  171. (I-AROUND-1 N-AROUND-1 I-BEFORE N-BEFORE I-PRIMARY-1 N-PRIMARY-1 INNERMOST
  172.   N-PRIMARY-2 I-PRIMARY-2 N-AFTER I-AFTER N-AROUND-2 I-AROUND-2
  173. )
  174.  
  175. (unintern '<C1>)
  176. T
  177.  
  178. (progn
  179. (defclass <C1> ()
  180.   ((x :initform 0 :accessor x-val :initarg :x)
  181.    (y :initform 1 :accessor y-val :initarg :y)))
  182. ())
  183. NIL
  184.  
  185. (defparameter a (make-instance (find-class '<C1>) :x 10))
  186. A
  187.  
  188. (defparameter b (make-instance (find-class '<C1>) :y 20 :x 10))
  189. B
  190.  
  191. (defparameter c (make-instance (find-class '<C1>)))
  192. C
  193.  
  194. (x-val a)
  195. 10
  196.  
  197. (y-val a)
  198. 1
  199.  
  200. (x-val b)
  201. 10
  202.  
  203. (y-val b)
  204. 20
  205.  
  206. (x-val c)
  207. 0
  208.  
  209. (y-val c)
  210. 1
  211.  
  212. (unintern '<C1>)
  213. T
  214.  
  215. (progn
  216. (defclass <C1> ()
  217.   ((x :initform 0 :accessor x-val :initarg :x)
  218.    (y :initform 1 :accessor y-val :initarg :y)))
  219. (defmethod initialize-instance :after ((instance <C1>) &rest initvalues)
  220.   (if (= (x-val instance) 0)
  221.     (setf (x-val instance) (y-val instance))))
  222. ())
  223. NIL
  224.  
  225. (x-val (make-instance (find-class '<C1>)))
  226. 1
  227.  
  228. (x-val (make-instance (find-class '<C1>) :x 10))
  229. 10
  230.  
  231. (x-val (make-instance (find-class '<C1>) :y 20))
  232. 20
  233.  
  234. (x-val (make-instance (find-class '<C1>) :x 10 :y 20))
  235. 10
  236.  
  237. (unintern '<C1>)
  238. T
  239.  
  240. (eq (class-of ())               (find-class 'null))
  241. T
  242.  
  243. (eq (class-of t)                (find-class 'symbol))
  244. T
  245.  
  246. (eq (class-of 10)               (find-class 'integer))
  247. T
  248.  
  249. (eq (class-of 10.0)             (find-class 'float))
  250. T
  251.  
  252. (eq (class-of '(a b))           (find-class 'cons))
  253. T
  254.  
  255. (eq (class-of "abc")            (find-class 'string))
  256. T
  257.  
  258. (eq (class-of '#(1 2))          (find-class 'vector))
  259. T
  260.  
  261. (eq (class-of #'car)            (find-class 'function))
  262. T
  263.  
  264. (eq (class-of #'make-instance)  (find-class 'standard-generic-function))
  265. T
  266.  
  267. (eq (class-of '#2a((a) (b)))    (find-class 'array))
  268. T
  269.  
  270. (eq (class-of *standard-input*) (find-class 'stream))
  271. NIL
  272.  
  273. (eq (class-of (lambda (x) x))   (find-class 'function))
  274. T
  275.  
  276. (eq (class-of (find-class 't)) (find-class 'built-in-class))
  277. T
  278.  
  279. (typep "abc" (find-class 't))
  280. T
  281.  
  282. (typep "abc" (find-class 'array))
  283. T
  284.  
  285. (typep "abc" (find-class 'vector))
  286. T
  287.  
  288. (typep "abc" (find-class 'string))
  289. T
  290.  
  291. (typep "abc" (find-class 'integer))
  292. NIL
  293.  
  294. (typep 3 (find-class 't))
  295. T
  296.  
  297. (typep 3 (find-class 'number))
  298. T
  299.  
  300. (typep 3 (find-class 'float))
  301. NIL
  302.  
  303. (typep 3 (find-class 'integer))
  304. T
  305.  
  306. (typep 3 (find-class 'string))
  307. NIL
  308.  
  309. (typep *standard-input* (find-class 'stream))
  310. T
  311.  
  312. (clos::subclassp (find-class 'number)           (find-class 't))
  313. T
  314.  
  315. (clos::subclassp (find-class 'integer)          (find-class 'number))
  316. T
  317.  
  318. (clos::subclassp (find-class 'float)            (find-class 'number))
  319. T
  320.