From cc67baa3070a13bd84bb37680761011e689fb917 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 3 Nov 2013 23:32:09 +0400 Subject: [PATCH] Fix EQUALP on structures with raw slots. It always incremented the index by 1, even if slot takes up more than one word. Increment by raw-slot-data-n-words. --- NEWS | 2 ++ src/code/target-defstruct.lisp | 10 +++++----- tests/defstruct.impure.lisp | 16 +++++++++++++++- 3 files changed, 22 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 4e427c5..3cb5e54 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,8 @@ changes relative to sbcl-1.1.13: * enhancement: Top-level defmethod without defgeneric no longer causes undefined-function warnings in subsequent forms. (lp#503095) + * bug fix: EQUALP now compares correctly structures with raw slots larger + than a single word. changes in sbcl-1.1.13 relative to sbcl-1.1.12: * optimization: better distribution of SXHASH over small conses of related diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 89ced39..f397731 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -394,7 +394,7 @@ ;; all this with %RAW-INSTANCE-REF/WORD and bitwise comparisons, but ;; that'll fail in some cases. For example -0.0 and 0.0 are EQUALP ;; but have different bit patterns. -- JES, 2007-08-21 - (loop with i = -1 + (loop with i = 0 for dsd in (dd-slots (layout-info layout)) for raw-type = (dsd-raw-type dsd) for rsd = (when raw-type @@ -404,10 +404,10 @@ for accessor = (when rsd (raw-slot-data-accessor-name rsd)) always (or (not accessor) - (progn - (incf i) - (equalp (funcall accessor x i) - (funcall accessor y i)))))) + (prog1 + (equalp (funcall accessor x i) + (funcall accessor y i)) + (incf i (raw-slot-data-n-words rsd)))))) ;;; default PRINT-OBJECT method diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index 00aa376..9bfc78c 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -710,6 +710,12 @@ c (a 0d0 :type double-float)) +(defstruct raw-slot-equalp-bug-2 + (b (complex 1d0) :type (complex double-float)) + (x (complex 1d0) :type (complex double-float)) + c + (a 1s0 :type single-float)) + (with-test (:name :raw-slot-equalp) (assert (equalp (make-raw-slot-equalp-bug :a 1d0 :b 2s0) (make-raw-slot-equalp-bug :a 1d0 :b 2s0))) @@ -718,7 +724,15 @@ (assert (not (equalp (make-raw-slot-equalp-bug :a 1d0 :b 2s0) (make-raw-slot-equalp-bug :a 1d0 :b 3s0)))) (assert (not (equalp (make-raw-slot-equalp-bug :a 1d0 :b 2s0) - (make-raw-slot-equalp-bug :a 2d0 :b 2s0))))) + (make-raw-slot-equalp-bug :a 2d0 :b 2s0)))) + (assert (equalp (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 2s0) + (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 2s0))) + (assert (equalp (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 0s0) + (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a -0s0))) + (assert (not (equalp (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 2s0) + (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 3s0)))) + (assert (not (equalp (make-raw-slot-equalp-bug-2 :b (complex 1d0) :a 2s0) + (make-raw-slot-equalp-bug-2 :b (complex 2d0) :a 2s0))))) ;;; Check that all slot types (non-raw and raw) can be initialized with ;;; constant arguments. -- 1.7.10.4