47 |
(eqt (setf (rest x) 'd) 'd) |
(eqt (setf (rest x) 'd) 'd) |
48 |
x)) |
x)) |
49 |
(a . d)) |
(a . d)) |
50 |
|
|
51 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
52 |
;;; setting of C*R accessors |
;;; setting of C*R accessors |
53 |
|
|
70 |
(symbol-name fn) |
(symbol-name fn) |
71 |
"-SET") |
"-SET") |
72 |
:cl-test) |
:cl-test) |
73 |
(let ((x (create-c*r-test ,level))) |
(let ((x (create-c*r-test ,level)) |
74 |
|
(y (list (create-c*r-test ,level))) |
75 |
|
(i 0)) |
76 |
(and |
(and |
77 |
(setf (,fn x) 'a) |
(setf (,fn (progn (incf i) x)) 'a) |
78 |
(eql (,fn x) 'a) |
(eqlt (,fn x) 'a) |
79 |
|
(eqlt i 1) |
80 |
(setf (,fn x) 'none) |
(setf (,fn x) 'none) |
81 |
(equal x (create-c*r-test ,level)) |
(equalt x (create-c*r-test ,level)) |
82 |
|
(setf (,fn (progn (incf i) (car y))) 'a) |
83 |
|
(eqlt (,fn (car y)) 'a) |
84 |
|
(eqlt i 2) |
85 |
|
(setf (,fn (car y)) 'none) |
86 |
|
(null (cdr y)) |
87 |
|
(equalt (car y) (create-c*r-test ,level)) |
88 |
)) |
)) |
89 |
t)))) |
t)))) |
90 |
|
|
99 |
(symbol-name fn) |
(symbol-name fn) |
100 |
"-SET") |
"-SET") |
101 |
:cl-test) |
:cl-test) |
102 |
(let ((x (make-list 20 :initial-element nil))) |
(let* ((x (make-list 20 :initial-element nil)) |
103 |
|
(y (list (copy-list x))) |
104 |
|
(cnt 0)) |
105 |
(and |
(and |
106 |
(setf (,fn x) 'a) |
(setf (,fn (progn (incf cnt) x)) 'a) |
107 |
|
(eqlt cnt 1) |
108 |
(loop |
(loop |
109 |
for i from 1 to 20 |
for i from 1 to 20 |
110 |
do (when (and (not (eql i ,len)) |
do (when (and (not (eql i ,len)) |
111 |
(nth (1- i) x)) |
(nth (1- i) x)) |
112 |
(return nil)) |
(return nil)) |
113 |
finally (return t)) |
finally (return t)) |
114 |
(eql (,fn x) 'a) |
(setf (,fn (car y)) 'a) |
115 |
(nth ,(1- len) x))) |
(loop |
116 |
a))) |
for i from 1 to 20 |
117 |
|
do (when (and (not (eql i ,len)) |
118 |
|
(nth (1- i) (car y))) |
119 |
|
(return nil)) |
120 |
|
finally (return t)) |
121 |
|
(eqlt (,fn x) 'a) |
122 |
|
(eqlt (nth ,(1- len) x) 'a) |
123 |
|
(eqlt (,fn (car y)) 'a) |
124 |
|
(nth ,(1- len) (car y)))) |
125 |
|
a))) |
126 |
|
|
127 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
128 |
;;; nth |
;;; nth |
147 |
(error (c) c)) |
(error (c) c)) |
148 |
t) |
t) |
149 |
|
|
150 |
#| |
;;; Test side effects, evaluation order in assignment to NTH |
151 |
(deftest nth-3 |
(deftest nth-3 |
152 |
(catch-type-error (nth -1 (copy-tree '(a b c)))) |
(let ((i 0) |
153 |
type-error) |
(x (list 'a 'b 'c 'd)) |
154 |
|
y z) |
155 |
(deftest nth-4 |
(and |
156 |
(catch-type-error (nth 'a (copy-tree '(a b c)))) |
(eqlt (setf (nth (setf y (incf i)) x) (progn (setf z (incf i)) 'z)) |
157 |
type-error) |
'z) |
158 |
|# |
(eqlt y 1) |
159 |
|
(eqlt z 2) |
160 |
|
x)) |
161 |
|
(a z c d)) |