/[gcl]/gcl/tests/symbol10.tst
ViewVC logotype

Diff of /gcl/tests/symbol10.tst

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
1    (progn (in-package 'user)nil)
2    NIL
3    ;; Test der neuen Valuezelle
4    
5    ;;; 1. ungebundenes Symbol
6    
7    (defun testvar (var)
8       (list (boundp var)                                ; gebunden
9             (if (boundp var) (symbol-value var) nil)    ; Wert/nil
10             (constantp var)                             ; Konstante
11             #+XCL (eq (sys::%p-get-cdr var 0) sys::%cdr-specsym) ; specvar
12             #+CLISP (and (sys::special-variable-p var) (not (constantp var))) ; specvar
13             (fboundp var)                               ; funktion. Eigenschaft
14             (and (fboundp var) (macro-function var) t)  ; Macro?
15             (and (fboundp var) (special-form-p var) t)  ; Spezialform?
16             #-CLISP (and (symbol-plist var) t)          ; p-Liste?
17             #+CLISP (and (or (get var 'i1) (get var 'i2) (get var 'i3)) t) ; p-Liste?
18             (get var 'i1)                               ; i1
19             (get var 'i2)                               ; i2
20             (get var 'i3)                               ; i3
21    )  )
22    testvar
23    
24    (defun clrvar (var)
25       #+XCL(subr 84 ;sys::%p-set-cdr-content
26                  var 0 (sys::%p-get-content 'sys::%void-value 0) 0)
27       #+CLISP (progn (makunbound var) (fmakunbound var)
28                      (setf (symbol-plist var) '())
29               )
30       var)
31    clrvar
32    
33    #+CLISP (progn (setf (symbol-function 'sys::setf-get) (symbol-function 'sys::%put)) t)
34    #+CLISP T
35    
36    ;;; Begin Breitentest
37    
38    (clrvar 'v1)
39    v1
40    
41    ;;;; value - umbinden - macro - umbinden - props - umbinden
42    
43    ;;; value
44    
45    (testvar 'v1)
46    ;geb val konst svar func mac spec plist i1  i2  i3
47    (nil nil nil   nil  nil  nil nil  nil   nil nil nil)
48    
49    (setq v1 'val)
50    val
51    
52    (testvar 'v1)
53    ;geb val konst svar func mac spec plist i1  i2  i3
54    (t   val nil   nil  nil  nil nil  nil   nil nil nil)
55    
56    ;;; umbinden
57    
58    (makunbound 'v1)
59    v1
60    
61    (testvar 'v1)
62    ;geb val konst svar func mac spec plist i1  i2  i3
63    (nil nil nil   nil  nil  nil nil  nil   nil nil nil)
64    
65    (setq v1 'val2)
66    val2
67    
68    (testvar 'v1)
69    ;geb val  konst svar func mac spec plist i1  i2  i3
70    (t   val2 nil   nil  nil  nil nil  nil   nil nil nil)
71    
72    ;;; macro
73    
74    (defmacro v1 (x) (list 'quote x))
75    v1
76    
77    (testvar 'v1)
78    ;geb val  konst svar func mac spec plist i1  i2  i3
79    (t   val2 nil   nil  t    t   nil  nil   nil nil nil)
80    
81    ;;; umbinden
82    
83    (fmakunbound 'v1)
84    v1
85    
86    (testvar 'v1)
87    ;geb val  konst svar func mac spec plist i1  i2  i3
88    (t   val2 nil   nil  nil  nil nil  nil   nil nil nil)
89    
90    (defmacro v1 (x) (list 'quote (list x x)))
91    v1
92    
93    (v1 33)
94    (33 33)
95    
96    (testvar 'v1)
97    ;geb val  konst svar func mac spec plist i1  i2  i3
98    (t   val2 nil   nil  t    t   nil  nil   nil nil nil)
99    
100    (makunbound 'v1)
101    v1
102    
103    (testvar 'v1)
104    ;geb val  konst svar func mac spec plist i1  i2  i3
105    (nil nil  nil   nil  t    t   nil  nil   nil nil nil)
106    
107    (setq v1 'val3)
108    val3
109    
110    (testvar 'v1)
111    ;geb val  konst svar func mac spec plist i1  i2  i3
112    (t   val3 nil   nil  t    t   nil  nil   nil nil nil)
113    
114    ;;; props
115    
116    (sys::setf-get 'v1 'i1 11)
117    11
118    
119    (sys::setf-get 'v1 'i2 22)
120    22
121    
122    (sys::setf-get 'v1 'i3 33)
123    33
124    
125    (testvar 'v1)
126    ;geb val  konst svar func mac spec plist i1  i2  i3
127    (t   val3 nil   nil  t    t   nil  t     11  22  33)
128    
129    ;;; umbinden
130    
131    (remprop 'v1 'i2)
132    t
133    (remprop 'v1 'i1)
134    t
135    (remprop 'v1 'i3)
136    t
137    (fmakunbound 'v1)
138    v1
139    (makunbound 'v1)
140    v1
141    
142    (testvar 'v1)
143    ;geb val  konst svar func mac spec plist i1  i2  i3
144    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
145    
146    (sys::setf-get 'v1 'i1 99)
147    99
148    (defmacro v1 (x) (list 'quote (list x x x)))
149    v1
150    (v1 a)
151    (a a a)
152    (setq v1 'val4)
153    val4
154    
155    (testvar 'v1)
156    ;geb val  konst svar func mac spec plist i1  i2  i3
157    (t   val4 nil   nil  t    t   nil  t     99  nil nil)
158    
159    ;;; --- Ende Test1 -----
160    
161    (clrvar 'v2)
162    v2
163    
164    ;;; specvar - props - rebind - function
165    
166    (defvar v2 'v2a)
167    v2
168    
169    (testvar 'v2)
170    ;geb val  konst svar func mac spec plist i1  i2  i3
171    (t   v2a  nil   t    nil  nil nil  nil   nil nil nil)
172    
173    (sys::setf-get 'v2 'i3 33)
174    33
175    (sys::setf-get 'v2 'i2 22)
176    22
177    (sys::setf-get 'v2 'i1 11)
178    11
179    
180    (testvar 'v2)
181    ;geb val  konst svar func mac spec plist i1  i2  i3
182    (t   v2a  nil   t    nil  nil nil  t     11  22  33)
183    
184    ;;; rebind
185    
186    (makunbound 'v2)
187    v2
188    (remprop 'v2 'i1)
189    t
190    (remprop 'v2 'i2)
191    t
192    (remprop 'v2 'i3)
193    t
194    
195    (testvar 'v2)
196    ;geb val  konst svar func mac spec plist i1  i2  i3
197    #+XCL
198    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
199    #+CLISP
200    (nil nil  nil   t    nil  nil nil  nil   nil nil nil)
201    
202    (defvar v2 'v2b)
203    v2
204    (sys::setf-get 'v2 'i1 111)
205    111
206    (sys::setf-get 'v2 'i2 222)
207    222
208    (sys::setf-get 'v2 'i3 333)
209    333
210    
211    (testvar 'v2)
212    ;geb val  konst svar func mac spec plist i1  i2  i3
213    (t   v2b  nil   t    nil  nil nil  t     111 222 333)
214    
215    ;;; function
216    
217    (defun v2 (x) (list x x))
218    v2
219    (v2 44)
220    (44 44)
221    
222    (testvar 'v2)
223    ;geb val  konst svar func mac spec plist i1  i2  i3
224    (t   v2b  nil   t    t    nil nil  t     111 222 333 )
225    
226    
227    (clrvar 'v3)
228    v3
229    
230    ;;;;; function - con - rebind - prop
231    
232    ;;; function
233    
234    (defun v3 (x y) (list x y))
235    v3
236    
237    (testvar 'v3)
238    ;geb val  konst svar func mac spec plist i1  i2  i3
239    (nil nil  nil   nil  t    nil nil  nil   nil nil nil)
240    
241    ;;; constant
242    
243    (defconstant v3 99)
244    v3
245    
246    v3
247    99
248    (v3 'a 'b)
249    (a b)
250    
251    (testvar 'v3)
252    ;geb val  konst svar func mac spec plist i1  i2  i3
253    (t    99  t     nil  t    nil nil  nil   nil nil nil)
254    
255    ;;; rebind
256    
257    (makunbound 'v3)
258    #+XCL v3 #+CLISP ERROR
259    (fmakunbound 'v3)
260    v3
261    
262    #+XCL
263    (testvar 'v3)
264    #+XCL
265    ;geb val  konst svar func mac spec plist i1  i2  i3
266    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
267    
268    (defconstant v3 999)
269    v3
270    
271    (defun v3 (x) (list x x))
272    v3
273    (v3 'c)
274    (c c)
275    v3
276    999
277    
278    (testvar 'v3)
279    ;geb val  konst svar func mac spec plist i1  i2  i3
280    (t   999  t     nil  t    nil nil  nil   nil nil nil)
281    
282    ;;;defparameter
283    
284    (defparameter var33)
285    ERROR
286    
287    (defparameter var3 99)
288    var3
289    
290    var3
291    99
292    
293    (testvar 'var3)
294    ;geb val  konst svar func mac spec plist i1  i2  i3
295    (t    99  nil   T    nil  nil nil  nil   nil nil nil)
296    
297    ;;; rebind
298    
299    (makunbound 'var3)
300    var3
301    
302    (testvar 'var3)
303    ;geb val  konst svar func mac spec plist i1  i2  i3
304    #+XCL
305    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
306    #+CLISP
307    (nil nil  nil   t    nil  nil nil  nil   nil nil nil)
308    
309    ;;; props
310    
311    (sys::setf-get 'v3 'i2 222)
312    222
313    
314    (sys::setf-get 'v3 'i1 111)
315    111
316    
317    (testvar 'v3)
318    ;geb val  konst svar func mac spec plist i1  i2  i3
319    (t   999  t     nil  t    nil nil  t     111 222 nil)
320    
321    
322    (clrvar 'v4)
323    v4
324    
325    ;;;;  function - rebind - prop - rebind - specvar
326    
327    (defun v4 (x) x)
328    v4
329    (v4 55)
330    55
331    
332    (testvar 'v4)
333    ;geb val  konst svar func mac spec plist i1  i2  i3
334    (nil nil  nil   nil  t    nil nil  nil   nil nil nil)
335    
336    ;;; rebind
337    
338    (fmakunbound 'v4)
339    v4
340    (testvar 'v4)
341    ;geb val  konst svar func mac spec plist i1  i2  i3
342    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
343    
344    (defun v4 (x) (list x))
345    v4
346    (v4 88)
347    (88)
348    
349    (testvar 'v4)
350    ;geb val  konst svar func mac spec plist i1  i2  i3
351    (nil nil  nil   nil  t    nil nil  nil   nil nil nil)
352    
353    (sys::setf-get 'v4 'i1 11)
354    11
355    (sys::setf-get 'v4 'i2 22)
356    22
357    
358    (testvar 'v4)
359    ;geb val  konst svar func mac spec plist i1  i2  i3
360    (nil nil  nil   nil  t    nil nil  t     11  22  nil)
361    
362    ;;; rebind
363    
364    (fmakunbound 'v4)
365    v4
366    (remprop 'v4 'i1)
367    t
368    (remprop 'v4 'i2)
369    t
370    (testvar 'v4)
371    ;geb val  konst svar func mac spec plist i1  i2  i3
372    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
373    
374    (defun v4 (x) (list x x x))
375    v4
376    (v4 44)
377    (44 44 44)
378    (sys::setf-get 'v4 'i2 222)
379    222
380    (sys::setf-get 'v4 'i3 333)
381    333
382    
383    (testvar 'v4)
384    ;geb val  konst svar func mac spec plist i1  i2  i3
385    (nil nil  nil   nil  t    nil nil  t     nil 222 333)
386    
387    (defvar v4 'v4-value)
388    v4
389    
390    (testvar 'v4)
391    ;geb val     konst svar func mac spec plist i1  i2  i3
392    (t  v4-value nil   t    t    nil nil  t     nil 222 333)
393    
394    (clrvar 'v5)
395    v5
396    
397    ;;;;; prop - rebind - con - rebind - fun
398    
399    (sys::setf-get 'v5 'i1 1)
400    1
401    (sys::setf-get 'v5 'i2 2)
402    2
403    
404    (testvar 'v5)
405    ;geb val  konst svar func mac spec plist i1  i2  i3
406    (nil nil  nil   nil  nil  nil nil  t     1   2  nil)
407    
408    ;;; rebind
409    
410    (remprop 'v5 'i1)
411    t
412    (remprop 'v5 'i2)
413    t
414    
415    (testvar 'v5)
416    ;geb val  konst svar func mac spec plist i1  i2  i3
417    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
418    
419    (sys::setf-get 'v5 'i1 11)
420    11
421    (sys::setf-get 'v5 'i2 22)
422    22
423    
424    (testvar 'v5)
425    ;geb val  konst svar func mac spec plist i1  i2  i3
426    (nil nil  nil   nil  nil  nil nil  t     11  22  nil)
427    
428    ;;; con
429    
430    (defconstant v5 '123)
431    v5
432    
433    (testvar 'v5)
434    ;geb val  konst svar func mac spec plist i1  i2  i3
435    (t   123  t     nil  nil  nil nil  t     11  22  nil)
436    
437    ;;; rebind
438    
439    (makunbound 'v5)
440    #+XCL v5 #+CLISP ERROR
441    (remprop 'v5 'i2)
442    t
443    (remprop 'v5 'i1)
444    t
445    
446    #+XCL
447    (testvar 'v5)
448    #+XCL
449    ;geb val  konst svar func mac spec plist i1  i2  i3
450    (nil nil  nil   nil  nil  nil nil  nil   nil nil nil)
451    
452    ;;; das ging schief !!
453    
454    (defconstant v5 321)
455    v5
456    (sys::setf-get 'v5 'i3 333)
457    333
458    (sys::setf-get 'v5 'i2 222)
459    222
460    
461    (testvar 'v5)
462    ;geb val  konst svar func mac spec plist i1  i2  i3
463    (t   321  t     nil  nil  nil nil  t     nil 222 333)
464    
465    (defun v5 (x) x)
466    v5
467    
468    (v5 666)
469    666
470    
471    (testvar 'v5)
472    ;geb val  konst svar func mac spec plist i1  i2  i3
473    (t   321  t     nil  t    nil nil  t     nil 222 333)
474    
475    (clrvar 'v6)
476    v6
477    
478    ;;;;; prop mac con
479    
480    (sys::setf-get 'v6 'i1 1)
481    1
482    (sys::setf-get 'v6 'i3 3)
483    3
484    
485    (testvar 'v6)
486    ;geb val  konst svar func mac spec plist i1  i2  i3
487    (nil nil  nil   nil  nil  nil nil  t     1   nil 3)
488    
489    (defmacro v6 (x) (list 'quote x))
490    v6
491    (v6 a)
492    a
493    (testvar 'v6)
494    ;geb val  konst svar func mac spec plist i1  i2  i3
495    (nil nil  nil   nil  t    t   nil  t     1   nil 3)
496    
497    (defconstant v6 234)
498    v6
499    
500    (testvar 'v6)
501    ;geb val  konst svar func mac spec plist i1  i2  i3
502    (t   234  t     nil  t    t   nil  t     1   nil 3)
503    
504    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26