From c7319d03f99cc06287e0c14b0f954888100ca747 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sun, 26 Jun 2005 02:48:25 +0000
Subject: [PATCH] Added tests involving two uses of the same accessor

---
 ansi-tests/rotatef.lsp | 283 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 282 insertions(+), 1 deletion(-)

diff --git a/ansi-tests/rotatef.lsp b/ansi-tests/rotatef.lsp
index f4fafece..d943439d 100644
--- a/ansi-tests/rotatef.lsp
+++ b/ansi-tests/rotatef.lsp
@@ -68,4 +68,285 @@
   a b nil b a)
   
 
-;;; Need to add more tests for ROTATEF here
+;;; ROTATEF is a good testbed for finding conflicts in setf expansions
+;;; These tests apply rotatef to various accessors
+
+(deftest rotatef.6
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z 'e))
+    (rotatef (car x) (car y) z)
+    (values x y z))
+  (c b) (e d) a)
+
+(deftest rotatef.7
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z 'e))
+    (rotatef (first x) (first y) z)
+    (values x y z))
+  (c b) (e d) a)
+
+(deftest rotatef.8
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z '(e)))
+    (rotatef (cdr x) (cdr y) z)
+    (values x y z))
+  (a d) (c e) (b))
+
+(deftest rotatef.9
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z '(e)))
+    (rotatef (rest x) (rest y) z)
+    (values x y z))
+  (a d) (c e) (b))
+
+(deftest rotatef.10
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z 'e))
+    (rotatef (cadr x) (cadr y) z)
+    (values x y z))
+  (a d) (c e) b)
+
+(deftest rotatef.11
+  (let* ((x (list 'a 'b))
+	 (y (list 'c 'd))
+	 (z 'e))
+    (rotatef (second x) (second y) z)
+    (values x y z))
+  (a d) (c e) b)
+
+(deftest rotatef.12
+  (let* ((x (list 'a 'b 'c))
+	 (y (list 'd 'e 'f))
+	 (z (list 'g)))
+    (rotatef (cddr x) (cddr y) z)
+    (values x y z))
+  (a b f) (d e g) (c))
+
+(deftest rotatef.13
+  (let* ((x (list (list 'a)))
+	 (y (list (list 'c)))
+	 (z 'e))
+    (rotatef (caar x) (caar y) z)
+    (values x y z))
+  ((c)) ((e)) a)
+
+(deftest rotatef.14
+  (let* ((x (list (list 'a 'b)))
+	 (y (list (list 'c 'd)))
+	 (z (list 'e)))
+    (rotatef (cdar x) (cdar y) z)
+    (values x y z))
+  ((a d)) ((c e)) (b))
+
+;;; TODO: c*r accessors with > 2 a/d
+;;; TODO: third,...,tenth
+
+(deftest rotatef.15
+  (let* ((x (vector 'a 'b))
+	 (y (vector 'c 'd))
+	 (z 'e))
+    (rotatef (aref x 0) (aref y 0) z)
+    (values x y z))
+  #(c b) #(e d) a)
+
+(deftest rotatef.16
+  (let* ((x (vector 'a 'b))
+	 (y (vector 'c 'd))
+	 (z 'e))
+    (rotatef (svref x 0) (svref y 0) z)
+    (values x y z))
+  #(c b) #(e d) a)
+
+(deftest rotatef.17
+  (let* ((x (copy-seq #*11000))
+	 (y (copy-seq #*11100))
+	 (z 1))
+    (rotatef (bit x 1) (bit y 3) z)
+    (values x y z))
+  #*10000 #*11110 1)
+
+(deftest rotatef.18
+  (let* ((x (copy-seq "abcde"))
+	 (y (copy-seq "fghij"))
+	 (z #\X))
+    (rotatef (char x 1) (char y 2) z)
+    (values x y z))
+  "ahcde" "fgXij" #\b)
+
+(deftest rotatef.21
+  (let* ((x (copy-seq #*11000))
+	 (y (copy-seq #*11100))
+	 (z 1))
+    (rotatef (bit x 1) (bit y 3) z)
+    (values x y z))
+  #*10000 #*11110 1)  
+
+(deftest rotatef.22
+  (let* ((x (copy-seq "abcde"))
+	 (y (copy-seq "fghij"))
+	 (z #\X))
+    (rotatef (char x 1) (char y 2) z)
+    (values x y z))
+  "ahcde" "fgXij" #\b)
+
+(deftest rotatef.23
+  (let* ((x (copy-seq '(a b c d e)))
+	 (y (copy-seq '(f g h i j)))
+	 (z 'k))
+    (rotatef (elt x 1) (elt y 2) z)
+    (values x y z))
+  (a h c d e) (f g k i j) b)
+
+(deftest rotatef.24
+  (let ((x #b01010101)
+	(y #b1111)
+	(z 0))
+    (rotatef (ldb (byte 4 2) x)
+	     (ldb (byte 4 1) y)
+	     z)
+    (values x y z))
+  #b01011101
+  1
+  #b0101)
+
+(deftest rotatef.25
+  (let* ((f1 (gensym))
+	 (f2 (gensym))
+	 (fn1 (constantly :foo))
+	 (fn2 (constantly :bar))
+	 (fn3 (constantly :zzz)))
+    (setf (fdefinition f1) fn1
+	  (fdefinition f2) fn2)
+    (rotatef (fdefinition f1)
+	     (fdefinition f2)
+	     fn3)
+    (values (funcall f1) (funcall f2) (funcall fn3)))
+  :bar :zzz :foo)
+
+(deftest rotatef.26
+  (let* ((a1 (make-array '(10) :fill-pointer 5))
+	 (a2 (make-array '(20) :fill-pointer 7))
+	 (z 3))
+    (rotatef (fill-pointer a1) (fill-pointer a2) z)
+    (values (fill-pointer a1) (fill-pointer a2) z))
+  7 3 5)
+
+(deftest rotatef.27
+  (let* ((x (list 'a 'b 'c 'd))
+	 (y (list 'd 'e 'f 'g))
+	 (n1 1) (n2 2)
+	 (z 'h))
+    (rotatef (nth n1 x) (nth n2 y) z)
+    (values x y z))
+  (a f c d)
+  (d e h g)
+  b)
+
+(deftest rotatef.28
+  (let* ((f1 (gensym))
+	 (f2 (gensym))
+	 (fn1 (constantly :foo))
+	 (fn2 (constantly :bar))
+	 (fn3 (constantly :zzz)))
+    (setf (symbol-function f1) fn1
+	  (symbol-function f2) fn2)
+    (rotatef (symbol-function f1) (symbol-function f2) fn3)
+    (values (funcall f1) (funcall f2) (funcall fn3)))
+  :bar :zzz :foo)
+
+(deftest rotatef.29
+  (let* ((s1 (gensym))
+	 (s2 (gensym))
+	 (z 1))
+    (setf (symbol-value s1) :foo
+	  (symbol-value s2) :bar)
+    (rotatef (symbol-value s1)
+	     (symbol-value s2)
+	     z)
+    (values (symbol-value s1) (symbol-value s2) z))
+  :bar 1 :foo)
+
+(deftest rotatef.30
+  (let* ((s1 (gensym))
+	 (s2 (gensym))
+	 (v1 (list :foo 1))
+	 (v2 (list :bar 2))
+	 (z nil))
+    (setf (symbol-plist s1) v1
+	  (symbol-plist s2) v2)
+    (rotatef (symbol-plist s1) (symbol-plist s2) z)
+    (values (symbol-plist s1) (symbol-plist s2) z))
+  (:bar 2) nil (:foo 1))
+
+(deftest rotatef.31
+  (let* ((x (list 'a 'b 'c 'd 'e))
+	 (y (list 'f 'g 'h 'i 'j))
+	 (p1 1) (p2 2) (len 3)
+	 (z '(10 11 12)))
+    (rotatef (subseq x p1 (+ p1 len))
+	     (subseq y p2 (+ p2 len))
+	     z)
+    (values x y z))
+  (a h i j e)
+  (f g 10 11 12)
+  (b c d))
+
+(deftest rotatef.32
+  (let* ((x (gensym))
+	 (y (gensym))
+	 (k1 :foo)
+	 (k2 :bar)
+	 (v1 1)
+	 (v2 2)
+	 (z 17))
+    (setf (get x k1) v1 (get y k2) v2)
+    (rotatef (get x k1) (get y k2) z)
+    (values (symbol-plist x) (symbol-plist y) z))
+  (:foo 2) (:bar 17) 1)
+
+(deftest rotatef.33
+  (let* ((x nil)
+	 (y nil)
+	 (k1 :foo)
+	 (k2 :bar)
+	 (v1 1)
+	 (v2 2)
+	 (z 21))
+    (setf (getf x k1) v1 (getf y k2) v2)
+    (rotatef (getf x k1) (getf y k2) z)
+    (values x y z))
+  (:foo 2) (:bar 21) 1)
+
+(deftest rotatef.34
+  (let* ((ht1 (make-hash-table))
+	 (ht2 (make-hash-table))
+	 (k1 :foo) (v1 1)
+	 (k2 :bar) (v2 2)
+	 (z 3))
+    (setf (gethash k1 ht1) v1
+	  (gethash k2 ht2) v2)
+    (rotatef z (gethash k1 ht1) (gethash k2 ht2))
+    (values z (gethash k1 ht1) (gethash k2 ht2)))
+  1 2 3)
+
+(deftest rotatef.35
+  (let ((n1 (gensym))
+	(n2 (gensym))
+	(n3 (gensym))
+	(n4 (gensym)))
+    (eval `(defclass ,n1 () ()))
+    (eval `(defclass ,n2 () ()))
+    (setf (find-class n3) (find-class n1)
+	  (find-class n4) (find-class n2))
+    (rotatef (find-class n3) (find-class n4))
+    (values (eqlt (find-class n1) (find-class n4))
+	    (eqlt (find-class n2) (find-class n3))))
+  t t)
+
+;;; TODO: macro-function, mask-field, row-major-aref,
+;;;   logical-pathname-translations, readtable-case
-- 
GitLab