[armedbear-cvs] r13971 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Sun Jun 17 04:26:43 2012
New Revision: 13971

Log:
fix ansi tests SLOT-UNBOUND.5, SLOT-UNBOUND.6

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jun 17 03:54:11 2012	(r13970)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jun 17 04:26:43 2012	(r13971)
@@ -2017,7 +2017,8 @@
                               (cdr location) ; :allocation :class
                               (funcallable-standard-instance-access arg location))))
                (if (eq value +slot-unbound+)
-                   (slot-unbound class arg slot-name)
+                   ;; fix SLOT-UNBOUND.5 from ansi test suite
+                   (nth-value 0 (slot-unbound class arg slot-name))
                    value))))))
 
     (t
@@ -3127,7 +3128,8 @@
                     (cdr location)      ; :allocation :class
                     (standard-instance-access instance location))))
     (if (eq value +slot-unbound+)
-        (slot-unbound class instance (slot-definition-name slot))
+        ;; fix SLOT-UNBOUND.5 from ansi test suite
+        (nth-value 0 (slot-unbound class instance (slot-definition-name slot)))
         value)))
 
 (defmethod slot-value-using-class ((class funcallable-standard-class)
@@ -3140,7 +3142,8 @@
                     (cdr location)      ; :allocation :class
                     (funcallable-standard-instance-access instance location))))
     (if (eq value +slot-unbound+)
-        (slot-unbound class instance (slot-definition-name slot))
+        ;; fix SLOT-UNBOUND.5 from ansi test suite
+        (nth-value 0 (slot-unbound class instance (slot-definition-name slot)))
         value)))
 
 (defmethod slot-value-using-class ((class structure-class) instance