Skip to content
Snippets Groups Projects
Commit 5703d225 authored by camm's avatar camm
Browse files

Initial setf function implementation, removes about 1/5 of ansi test failures

parent 7150913a
No related branches found
No related tags found
No related merge requests found
...@@ -8,10 +8,11 @@ ...@@ -8,10 +8,11 @@
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(unless #| (fboundp 'class-precedence-list) |# nil (unless #| (fboundp 'class-precedence-list) |# nil
(report-and-ignore-errors (report-and-ignore-errors
(defgeneric class-precedence-list (x) (defgeneric class-precedence-list-foo (x)
(:method-combination list) (:method-combination list)
. .
#.(loop for s in *cl-types-that-are-classes-symbols* #.(loop for s in *cl-types-that-are-classes-symbols*
when (ignore-errors (pcl::find-class-from-cell s (pcl::find-class-cell s)))
collect collect
`(:method list ((x ,s)) ',s)))))) `(:method list ((x ,s)) ',s))))))
...@@ -27,7 +28,7 @@ ...@@ -27,7 +28,7 @@
"-CPL") "-CPL")
:cl-test)) :cl-test))
(let* ((obj ,objform) (let* ((obj ,objform)
(cpl (class-precedence-list obj))) (cpl (class-precedence-list-foo obj)))
(or ,(if ordered (or ,(if ordered
nil nil
`(and (not (eql (class-of obj) (find-class ',(first expected-cpl)))) `(and (not (eql (class-of obj) (find-class ',(first expected-cpl))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment