home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / setf.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  4.3 KB  |  344 lines
  1. (SETf LI1 '(A (B) ((C) (D)) )  VEC1 '#(0 1 2 3))
  2. #(0 1 2 3)
  3.  
  4. (setf pa 'old)
  5. old
  6.  
  7. (psetf pa 'new pao pa)
  8. nil
  9.  
  10. pa
  11. new
  12.  
  13. pao
  14. old
  15.  
  16. (SETF (NTH 1 LI1) (QUOTE UU))
  17. UU
  18.  
  19. (EVAL (QUOTE LI1))
  20. (A UU ((C) (D)))
  21.  
  22. (SETF (ELT LI1 1) (QUOTE OO))
  23. OO
  24.  
  25. (SETF (ELT VEC1 1) (QUOTE OO))
  26. OO
  27.  
  28. (EVAL (QUOTE LI1))
  29. (A OO ((C) (D)))
  30.  
  31. (EVAL (QUOTE VEC1))
  32. #(0 OO 2 3)
  33.  
  34. (SETF (REST LI1) (QUOTE ((WW))))
  35. ((WW))
  36.  
  37. (EVAL (QUOTE LI1))
  38. (A (WW))
  39.  
  40. (SETF (FIRST LI1) (QUOTE AA))
  41. AA
  42.  
  43. (FIRST LI1)
  44. AA
  45.  
  46. (SETF (SECOND LI1) (QUOTE BB))
  47. BB
  48.  
  49. (EVAL (QUOTE LI1))
  50. (AA BB)
  51.  
  52. (SETF (THIRD LI1) (QUOTE BB))
  53. ERROR
  54.  
  55. (EVAL (QUOTE LI1))
  56. (AA BB)
  57.  
  58.  
  59. (SETF (REST LI1) (QUOTE (2 3 4 5 6 7 8 9 10)))
  60. (2 3 4 5 6 7 8 9 10)
  61.  
  62. (SETF (SECOND LI1) 22)
  63. 22
  64.  
  65. (EVAL (QUOTE LI1))
  66. (AA 22 3 4 5 6 7 8 9 10)
  67.  
  68. (SETF (THIRD LI1) (QUOTE 33))
  69. 33
  70.  
  71. (SETF (FOURTH LI1) (QUOTE 44))
  72. 44
  73.  
  74. (SETF (FIFTH LI1) (QUOTE 55))
  75. 55
  76.  
  77. (SETF (SIXTH LI1) (QUOTE 66))
  78. 66
  79.  
  80. (SETF (SEVENTH LI1) (QUOTE 77))
  81. 77
  82.  
  83. (SETF (EIGHTH LI1) (QUOTE 88))
  84. 88
  85.  
  86. (SETF (NINTH LI1) (QUOTE 99))
  87. 99
  88.  
  89. (SETF (TENTH LI1) (QUOTE 1010))
  90. 1010
  91.  
  92. (EVAL (QUOTE LI1))
  93. (AA 22 33 44 55 66 77 88 99 1010)
  94.  
  95. (SETF (FIRST LI1) (QUOTE (((A)))))
  96. (((A)))
  97.  
  98. (SETF (CAAAR LI1) (QUOTE UU))
  99. UU
  100.  
  101. (CAAAR LI1)
  102. UU
  103.  
  104. (CAR LI1)
  105. ((UU))
  106.  
  107. (SETF (CAAR LI1) (QUOTE OO))
  108. OO
  109.  
  110. (EVAL (QUOTE LI1))
  111. ((OO) 22 33 44 55 66 77 88 99 1010)
  112.  
  113. (SETF (CAR LI1) (QUOTE II))
  114. II
  115.  
  116. (EVAL (QUOTE LI1))
  117. (II 22 33 44 55 66 77 88 99 1010)
  118.  
  119. (SETF (CDDDR LI1) (QUOTE PP))
  120. PP
  121.  
  122. (EVAL (QUOTE LI1))
  123. (II 22 33 . PP)
  124.  
  125. (SETF (CADDR LI1) (QUOTE 333))
  126. 333
  127.  
  128. (EVAL (QUOTE LI1))
  129. (II 22 333 . PP)
  130.  
  131. (SETF (SVREF VEC1 2) (QUOTE KK))
  132. KK
  133.  
  134. (EVAL (QUOTE VEC1))
  135. #(0 OO KK 3)
  136.  
  137. (SETF (GET (QUOTE A) (QUOTE B)) (QUOTE UU))
  138. UU
  139.  
  140. (GET (QUOTE A) (QUOTE B))
  141. UU
  142.  
  143. (SETF (GETF (CADR (SETQ XX (QUOTE (AAA (I1 V1 I2 V2))))) (QUOTE I2))
  144.  
  145. (QUOTE V222))
  146. V222
  147.  
  148. (EVAL (QUOTE XX))
  149. (AAA (I1 V1 I2 V222))
  150.  
  151. (GETF (CADR XX) (QUOTE I2))
  152. V222
  153.  
  154. (GETF (CADR XX) (QUOTE I1))
  155. V1
  156.  
  157. (SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP1)) "doc 1")
  158. "doc 1"
  159.  
  160. (SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 2")
  161. "doc 2"
  162.  
  163. (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
  164. #+XCL (TYP2 . "doc 2") #-XCL "doc 2"
  165.  
  166. (SETF (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) "doc 3")
  167. "doc 3"
  168.  
  169. (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2))
  170. #+XCL (TYP2 . "doc 3") #-XCL "doc 3"
  171.  
  172. (symbol-plist 'beispiel)
  173. #+XCL (DOCUMENTATION ((TYP2 . "doc 3") (TYP1 . "doc 1")))
  174. #+CLISP (SYSTEM::DOCUMENTATION-STRINGS (TYP2 "doc 3" TYP1 "doc 1"))
  175. #-(or XCL CLISP) UNKNOWN
  176.  
  177. (SETF (SYMBOL-VALUE (QUOTE XX)) (QUOTE VOELLIGNEU))
  178. VOELLIGNEU
  179.  
  180. (EVAL (QUOTE XX))
  181. VOELLIGNEU
  182.  
  183. (SETF (SYMBOL-FUNCTION (QUOTE FF))
  184.       (QUOTE (LAMBDA (X) (PRINT X) (QUOTE HELLO))))
  185. #+XCL FF
  186. #-XCL (LAMBDA (X) (PRINT X) 'HELLO)
  187.  
  188. (FF 5)
  189. HELLO
  190.  
  191. (defun xx nil 'a)
  192. xx
  193.  
  194. (progn (setf (symbol-function 'xx1) (symbol-function 'xx)) nil)
  195. nil
  196.  
  197. (xx1)
  198. a
  199.  
  200. (setq l '(a 1 c d))
  201. (a 1 c d)
  202.  
  203. (setf (the integer (cadr l)) 100)
  204. 100
  205.  
  206. l
  207. (a 100 c d)
  208.  
  209. (progn (setf a (make-hash-table)) t)
  210. t
  211.  
  212. (setf (gethash 'color a) 'brown)
  213. brown
  214.  
  215. (gethash 'color a)
  216. brown
  217.  
  218. (defstruct schiff masse)
  219. schiff
  220.  
  221. (progn (setf s1 (make-schiff)) nil)
  222. nil
  223.  
  224. (setf (schiff-masse s1) 500)
  225. 500
  226.  
  227. (schiff-masse s1)
  228. 500
  229.  
  230. (defmacro setf-test (v) `(svref ,v 3))
  231. setf-test
  232.  
  233. (progn (setf (macro-function 'setf-test1) (macro-function 'setf-test)) nil)
  234. nil
  235.  
  236. (setf (setf-test vec1) 'oho)
  237. oho
  238.  
  239. (eval 'vec1)
  240. #(0 OO KK oho)
  241.  
  242. (setf (setf-test1 vec1) 'hihi)
  243. hihi
  244.  
  245. (eval 'vec1)
  246. #(0 OO KK hihi)
  247.  
  248. ; (setf (displace ?? (svref vec1 3)) "aha")
  249. ; aha
  250.  
  251. ; (eval 'vec1)
  252. ; #(0 oo KK aha)
  253.  
  254. (progn (setf a (make-array '(4 3))) nil)
  255. nil
  256.  
  257. (aref a 2 2)
  258. #+XCL 0 #+(or CLISP AKCL) NIL #-(or XCL CLISP AKCL) UNKNOWN
  259.  
  260. (setf (apply #'aref a '(2 2)) 'xxxx)
  261. xxxx
  262.  
  263. (aref a 2 2)
  264. xxxx
  265.  
  266. (SETF (AREF '#(A B C) 1) (QUOTE II))
  267. II
  268.  
  269. (setf b #*101010)
  270. #*101010
  271.  
  272. (bit b 2)
  273. 1
  274.  
  275. (setf (bit b 2) 0)
  276. 0
  277.  
  278. (bit b 2)
  279. 0
  280.  
  281. (setf (sbit b 2) 1)
  282. 1
  283.  
  284. (sbit b 2)
  285. 1
  286.  
  287. (progn (setf a (make-array 5 :fill-pointer t)) t)
  288. t
  289.  
  290. (fill-pointer a)
  291. 5
  292.  
  293. (setf (fill-pointer a) 3)
  294. 3
  295.  
  296. (fill-pointer a)
  297. 3
  298.  
  299. (setf str "hose")
  300. "hose"
  301.  
  302. (setf (char str 0) #\d)
  303. #\d
  304.  
  305. str
  306. "dose"
  307.  
  308. (setf str "aaaxxxccc")
  309. "aaaxxxccc"
  310.  
  311. (setf (subseq str 3 6) "bbb")
  312. "bbb"
  313.  
  314. str
  315. "aaabbbccc"
  316.  
  317. (setq x (list 'a 'b 'c))
  318. (a b c)
  319.  
  320. (shiftf (cadr x) 'z)
  321. b
  322.  
  323. x
  324. (a z c)
  325.  
  326. (shiftf (cadr x) (cddr x) 'q)
  327. z
  328.  
  329. x
  330. (a (c) . q)
  331.  
  332. (progn (defsetf subseq (sequence start &optional end) (new-sequence)
  333.                        `(progn (replace ,sequence ,new-sequence
  334.                                         :start1 ,start :end1 ,end)
  335.                        ,new-sequence)) t)
  336. t
  337.  
  338. (setf s "asdfg" (subseq s 1 3) "xy")
  339. "xy"
  340.  
  341. s
  342. "axyfg"
  343.  
  344.