978 lines
26 KiB
Plaintext
978 lines
26 KiB
Plaintext
;; Function To Be Tested: psetf
|
|
;;
|
|
;; Source: Guy L Steele's CLTL, Chapter 7, Control Structure
|
|
;; Section: 7-2 Generalized Variables
|
|
;; Page: 97
|
|
;;
|
|
;; Created By: Jim Blum
|
|
;;
|
|
;; Creation Date: Oct 24, 1986
|
|
;;
|
|
;; Last Update: Nov 24, 1986 by John Park, The test file was reformatted due to
|
|
;; its unreadability and changes were made to the following do-test cases,
|
|
;; which failed the first time the test was run:
|
|
;; (PSETF-CAAAR, PSETF-GETHASH, PSETF-BIT, and PSETF-SBIT)
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>7-2-psetf.test
|
|
;;
|
|
;;
|
|
;; Syntax: (psetf {place newvalue)*)
|
|
;;
|
|
;; Function Description: The psetf {place newvalue} is evaluated and then checked
|
|
;; for correctness. This function is like setf except it evaluates {place
|
|
;; newvalue}* in parallel instead of sequentially.
|
|
;;
|
|
;; Argument(s): Place - when evaluated accesses a data object in some location and
|
|
;; inverts it to produce a corresponding form to update the location.
|
|
;; Newvalue - when evaluated gets stored according to above update form created
|
|
;;
|
|
;; Returns: value(s) of the last evaluated form of the selected clause
|
|
;;
|
|
;; Constraints/Limitations:
|
|
|
|
(DO-TEST PSETF-OF-A-SYMBOL
|
|
(AND (SETQ FOO 1)
|
|
(SETQ BAR 2)
|
|
(NOT
|
|
(PSETF
|
|
BAR
|
|
FOO
|
|
FOO
|
|
BAR))
|
|
(EQ FOO 2)
|
|
(EQ BAR 1)))
|
|
(DO-TEST PSETF-CAR
|
|
(AND (SETQ FOO '(A . A))
|
|
(SETQ BAR '(B . B))
|
|
(NOT
|
|
(PSETF
|
|
(CAR FOO)
|
|
(CAR BAR)
|
|
(CAR BAR)
|
|
(CAR FOO)))
|
|
(EQUAL FOO '(B . A))))
|
|
(DO-TEST PSETF-CDR
|
|
(AND (SETQ FOO '(A . A))
|
|
(SETQ BAR '(B . B))
|
|
(NOT
|
|
(PSETF
|
|
(CDR FOO)
|
|
(CDR BAR)
|
|
(CDR BAR)
|
|
(CDR FOO)))
|
|
(EQUAL FOO '(A . B))))
|
|
(DO-TEST PSETF-CAAR
|
|
(AND (SETQ FOO '((A . B) C . D))
|
|
(SETQ BAR '((E . F) G . H))
|
|
(NOT
|
|
(PSETF
|
|
(CAAR FOO)
|
|
(CAAR BAR)
|
|
(CAAR BAR)
|
|
(CAAR FOO)))
|
|
(EQ (CAAR FOO) 'E)))
|
|
(DO-TEST PSETF-CADR
|
|
(AND (SETQ FOO '((A . B) G . D))
|
|
(SETQ BAR '((E . F) C . H))
|
|
(NOT
|
|
(PSETF
|
|
(CADR FOO)
|
|
(CADR BAR)
|
|
(CADR BAR)
|
|
(CADR FOO)))
|
|
(EQ (CADR FOO) 'C)
|
|
(EQ (CADR BAR) 'G)))
|
|
(DO-TEST PSETF-CDAR
|
|
(AND (SETQ FOO '((A . F) C . D))
|
|
(SETQ BAR '((E . B) G . H))
|
|
(NOT
|
|
(PSETF
|
|
(CDAR FOO)
|
|
(CDAR BAR)
|
|
(CDAR BAR)
|
|
(CDAR FOO)))
|
|
(EQ (CDAR FOO) 'B)
|
|
(EQ (CDAR BAR) 'F)))
|
|
(DO-TEST PSETF-CDDR
|
|
(AND (SETQ FOO '((A . B) C . D))
|
|
(SETQ BAR '((E . F) G . H))
|
|
(NOT
|
|
(PSETF
|
|
(CDDR FOO)
|
|
(CDDR BAR)
|
|
(CDDR BAR)
|
|
(CDDR FOO)))
|
|
(EQ (CDDR FOO) 'H)
|
|
(EQ (CDDR BAR) 'D)))
|
|
(DO-TEST PSETF-CAAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CAAAR FOO)
|
|
(CAAAR BAR)
|
|
(CAAAR BAR)
|
|
(CAAAR FOO)))
|
|
(EQ (CAAAR FOO) 'I)
|
|
(EQ (CAAAR BAR) 'A)))
|
|
(DO-TEST PSETF-CAADR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CAADR FOO)
|
|
(CAADR BAR)
|
|
(CAADR BAR)
|
|
(CAADR FOO)))
|
|
(EQ (CAADR FOO) 'M)
|
|
(EQ (CAADR BAR) 'E)))
|
|
(DO-TEST PSETF-CADAR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CADAR FOO)
|
|
(CADAR BAR)
|
|
(CADAR BAR)
|
|
(CADAR FOO)))
|
|
(EQ (CADAR FOO) 'K)
|
|
(EQ (CADAR BAR) 'C)))
|
|
(DO-TEST PSETF-CADDR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CADDR FOO)
|
|
(CADDR BAR)
|
|
(CADDR BAR)
|
|
(CADDR FOO)))
|
|
(EQ (CADDR FOO) 'O)
|
|
(EQ (CADDR BAR) 'G)))
|
|
(DO-TEST PSETF-CDAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CDAAR FOO)
|
|
(CDAAR BAR)
|
|
(CDAAR BAR)
|
|
(CDAAR FOO)))
|
|
(EQ (CDAAR FOO) 'J)
|
|
(EQ (CDAAR BAR) 'B)))
|
|
(DO-TEST PSETF-CDADR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CDADR FOO)
|
|
(CDADR BAR)
|
|
(CDADR BAR)
|
|
(CDADR FOO)))
|
|
(EQ (CDADR FOO) 'N)
|
|
(EQ (CDADR BAR) 'F)))
|
|
(DO-TEST PSETF-CDDAR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CDDAR FOO)
|
|
(CDDAR BAR)
|
|
(CDDAR BAR)
|
|
(CDDAR FOO)))
|
|
(EQ (CDDAR FOO) 'L)
|
|
(EQ (CDDAR BAR) 'D)))
|
|
(DO-TEST PSETF-CDDDR
|
|
(AND (SETQ
|
|
FOO
|
|
'(((A . B) C . D) (E . F) G . H))
|
|
(SETQ
|
|
BAR
|
|
'(((I . J) K . L) (M . N) O . P))
|
|
(NOT
|
|
(PSETF
|
|
(CDDDR FOO)
|
|
(CDDDR BAR)
|
|
(CDDDR BAR)
|
|
(CDDDR FOO)))
|
|
(EQ (CDDDR FOO) 'P)
|
|
(EQ (CDDDR BAR) 'H)))
|
|
(DO-TEST PSETF-CAAAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CAAAAR FOO)
|
|
(CAAAAR BAR)
|
|
(CAAAAR BAR)
|
|
(CAAAAR FOO)))
|
|
(EQ (CAAAAR FOO) 'AA)
|
|
(EQ (CAAAAR BAR) 'A)))
|
|
(DO-TEST PSETF-CAAADR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CAAADR FOO)
|
|
(CAAADR BAR)
|
|
(CAAADR BAR)
|
|
(CAAADR FOO)))
|
|
(EQ (CAAADR FOO) 'II)
|
|
(EQ (CAAADR BAR) 'I)))
|
|
(DO-TEST PSETF-CAADAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CAADAR FOO)
|
|
(CAADAR BAR)
|
|
(CAADAR BAR)
|
|
(CAADAR FOO)))
|
|
(EQ (CAADAR FOO) 'EE)
|
|
(EQ (CAADAR BAR) 'E)))
|
|
(DO-TEST PSETF-CAADDR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CAADDR FOO)
|
|
(CAADDR BAR)
|
|
(CAADDR BAR)
|
|
(CAADDR FOO)))
|
|
(EQ (CAADDR FOO) 'MM)
|
|
(EQ (CAADDR BAR) 'M)))
|
|
(DO-TEST PSETF-CADAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CADAAR FOO)
|
|
(CADAAR BAR)
|
|
(CADAAR BAR)
|
|
(CADAAR FOO)))
|
|
(EQ (CADAAR FOO) 'CC)
|
|
(EQ (CADAAR BAR) 'C)))
|
|
(DO-TEST PSETF-CADADR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CADADR FOO)
|
|
(CADADR BAR)
|
|
(CADADR BAR)
|
|
(CADADR FOO)))
|
|
(EQ (CADADR FOO) 'KK)
|
|
(EQ (CADADR BAR) 'K)))
|
|
(DO-TEST PSETF-CADDAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CADDAR FOO)
|
|
(CADDAR BAR)
|
|
(CADDAR BAR)
|
|
(CADDAR FOO)))
|
|
(EQ (CADDAR FOO) 'GG)
|
|
(EQ (CADDAR BAR) 'G)))
|
|
(DO-TEST PSETF-CADDDR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CADDDR FOO)
|
|
(CADDDR BAR)
|
|
(CADDDR BAR)
|
|
(CADDDR FOO)))
|
|
(EQ (CADDDR FOO) 'OO)
|
|
(EQ (CADDDR BAR) 'O)))
|
|
(DO-TEST PSETF-CDAAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDAAAR FOO)
|
|
(CDAAAR BAR)
|
|
(CDAAAR BAR)
|
|
(CDAAAR FOO)))
|
|
(EQ (CDAAAR FOO) 'BB)
|
|
(EQ (CDAAAR BAR) 'B)))
|
|
(DO-TEST PSETF-CDADDR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDADDR FOO)
|
|
(CDADDR BAR)
|
|
(CDADDR BAR)
|
|
(CDADDR FOO)))
|
|
(EQ (CDADDR FOO) 'NN)
|
|
(EQ (CDADDR BAR) 'N)))
|
|
(DO-TEST PSETF-CDDAAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDDAAR FOO)
|
|
(CDDAAR BAR)
|
|
(CDDAAR BAR)
|
|
(CDDAAR FOO)))
|
|
(EQ (CDDAAR FOO) 'DD)
|
|
(EQ (CDDAAR BAR) 'D)))
|
|
(DO-TEST PSETF-CDDADR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDDADR FOO)
|
|
(CDDADR BAR)
|
|
(CDDADR BAR)
|
|
(CDDADR FOO)))
|
|
(EQ (CDDADR FOO) 'LL)
|
|
(EQ (CDDADR BAR) 'L)))
|
|
(DO-TEST PSETF-CDDDAR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDDDAR FOO)
|
|
(CDDDAR BAR)
|
|
(CDDDAR BAR)
|
|
(CDDDAR FOO)))
|
|
(EQ (CDDDAR FOO) 'HH)
|
|
(EQ (CDDDAR BAR) 'H)))
|
|
(DO-TEST PSETF-CDDDDR
|
|
(AND (SETQ
|
|
FOO
|
|
'((((A . B) C . D) (E . F) G . H)
|
|
((I . J) K . L)
|
|
(M . N)
|
|
O . P))
|
|
(SETQ
|
|
BAR
|
|
'((((AA . BB) CC . DD)
|
|
(EE . FF)
|
|
GG . HH)
|
|
((II . JJ) KK . LL)
|
|
(MM . NN)
|
|
OO . PP))
|
|
(NOT
|
|
(PSETF
|
|
(CDDDDR FOO)
|
|
(CDDDDR BAR)
|
|
(CDDDDR BAR)
|
|
(CDDDDR FOO)))
|
|
(EQ (CDDDDR FOO) 'PP)
|
|
(EQ (CDDDDR BAR) 'P)))
|
|
(DO-TEST PSETF-FIRST
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(FIRST FOO)
|
|
(FIRST BAR)
|
|
(FIRST BAR)
|
|
(FIRST FOO)))
|
|
(EQ (FIRST FOO) 'A)
|
|
(EQ (FIRST BAR) '1)))
|
|
(DO-TEST PSETF-SECOND
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(SECOND FOO)
|
|
(SECOND BAR)
|
|
(SECOND BAR)
|
|
(SECOND FOO)))
|
|
(EQ (SECOND FOO) 'B)
|
|
(EQ (SECOND BAR) '2)))
|
|
(DO-TEST PSETF-THIRD
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(THIRD FOO)
|
|
(THIRD BAR)
|
|
(THIRD BAR)
|
|
(THIRD FOO)))
|
|
(EQ (THIRD FOO) 'C)
|
|
(EQ (THIRD BAR) '3)))
|
|
(DO-TEST PSETF-FOURTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(FOURTH FOO)
|
|
(FOURTH BAR)
|
|
(FOURTH BAR)
|
|
(FOURTH FOO)))
|
|
(EQ (FOURTH FOO) 'D)
|
|
(EQ (FOURTH BAR) '4)))
|
|
(DO-TEST PSETF-FIFTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(FIFTH FOO)
|
|
(FIFTH BAR)
|
|
(FIFTH BAR)
|
|
(FIFTH FOO)))
|
|
(EQ (FIFTH FOO) 'E)
|
|
(EQ (FIFTH BAR) '5)))
|
|
(DO-TEST PSETF-FIFTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(FIFTH FOO)
|
|
(FIFTH BAR)
|
|
(FIFTH BAR)
|
|
(FIFTH FOO)))
|
|
(EQ (FIFTH FOO) 'E)
|
|
(EQ (FIFTH BAR) '5)))
|
|
(DO-TEST PSETF-SIXTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(SIXTH FOO)
|
|
(SIXTH BAR)
|
|
(SIXTH BAR)
|
|
(SIXTH FOO)))
|
|
(EQ (SIXTH FOO) 'F)
|
|
(EQ (SIXTH BAR) '6)))
|
|
(DO-TEST PSETF-SEVENTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(SEVENTH FOO)
|
|
(SEVENTH BAR)
|
|
(SEVENTH BAR)
|
|
(SEVENTH FOO)))
|
|
(EQ (SEVENTH FOO) 'G)
|
|
(EQ (SEVENTH BAR) '7)))
|
|
(DO-TEST PSETF-EIGHTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(EIGHTH FOO)
|
|
(EIGHTH BAR)
|
|
(EIGHTH BAR)
|
|
(EIGHTH FOO)))
|
|
(EQ (EIGHTH FOO) 'H)
|
|
(EQ (EIGHTH BAR) '8)))
|
|
(DO-TEST PSETF-NINTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(NINTH FOO)
|
|
(NINTH BAR)
|
|
(NINTH BAR)
|
|
(NINTH FOO)))
|
|
(EQ (NINTH FOO) 'I)
|
|
(EQ (NINTH BAR) '9)))
|
|
(DO-TEST PSETF-TENTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(TENTH FOO)
|
|
(TENTH BAR)
|
|
(TENTH BAR)
|
|
(TENTH FOO)))
|
|
(EQ (TENTH FOO) 'J)
|
|
(EQ (TENTH BAR) '10)))
|
|
(DO-TEST PSETF-REST
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(REST FOO)
|
|
(REST BAR)
|
|
(REST BAR)
|
|
(REST FOO)))
|
|
(EQUAL FOO '(1 B C D E F G H I J))
|
|
(EQUAL BAR '(A 2 3 4 5 6 7 8 9 10))))
|
|
(DO-TEST PSETF-NTH
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(NTH 6 FOO)
|
|
(NTH 6 BAR)
|
|
(NTH 6 BAR)
|
|
(NTH 6 FOO)))
|
|
(EQUAL FOO '(1 2 3 4 5 6 G 8 9 10))
|
|
(EQUAL BAR '(A B C D E F 7 H I J))))
|
|
(DO-TEST PSETF-NTHCDR
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(NTHCDR 6 FOO)
|
|
(NTHCDR 6 BAR)
|
|
(NTHCDR 6 BAR)
|
|
(NTHCDR 6 FOO)))
|
|
(EQUAL FOO '(1 2 3 4 5 6 G H I J))
|
|
(EQUAL BAR '(A B C D E F 7 8 9 10))))
|
|
(DO-TEST PSETF-AREF
|
|
(AND (SETQ
|
|
FOO
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(1 2 3 4 5 6 7 8 9 10)))
|
|
(SETQ
|
|
BAR
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(A B C D E F G H I J)))
|
|
(NOT
|
|
(PSETF
|
|
(AREF FOO 6)
|
|
(AREF BAR 6)
|
|
(AREF BAR 6)
|
|
(AREF FOO 6)))
|
|
(EQUAL (AREF FOO 6) 'G)
|
|
(EQUAL (AREF BAR 6) '7)))
|
|
(DO-TEST PSETF-SVREF
|
|
(AND (SETQ
|
|
FOO
|
|
(VECTOR 1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ
|
|
BAR
|
|
(VECTOR
|
|
'A
|
|
'B
|
|
'C
|
|
'D
|
|
'E
|
|
'F
|
|
'G
|
|
'H
|
|
'I
|
|
'J))
|
|
(NOT
|
|
(PSETF
|
|
(SVREF FOO 6)
|
|
(SVREF BAR 6)
|
|
(SVREF BAR 6)
|
|
(SVREF FOO 6)))
|
|
(EQUAL (SVREF FOO 6) 'G)
|
|
(EQUAL (SVREF BAR 6) '7)))
|
|
(DO-TEST PSETF-GET
|
|
(AND (SETF (GET 'FOO 'A) 'B)
|
|
(SETF (GET 'BAR 'C) 'D)
|
|
(NOT
|
|
(PSETF
|
|
(GET 'FOO 'A)
|
|
(GET 'BAR 'C)
|
|
(GET 'BAR 'C)
|
|
(GET 'FOO 'A)))
|
|
(EQUAL (GET 'FOO 'A) 'D)
|
|
(EQUAL (GET 'BAR 'C) 'B)))
|
|
(DO-TEST PSETF-GETF
|
|
(AND (SETQ FOO '(B C D E F))
|
|
(SETQ BAR '(H I J K L))
|
|
(NOT
|
|
(PSETF
|
|
(GETF FOO 'D)
|
|
(GETF BAR 'J)
|
|
(GETF BAR 'J)
|
|
(GETF FOO 'D)))
|
|
(EQUAL FOO '(B C D K F))
|
|
(EQUAL BAR '(H I J E L))))
|
|
(DO-TEST PSETF-GETHASH
|
|
(AND (SETQ FOO (MAKE-HASH-TABLE))
|
|
(SETF (GETHASH 'A FOO) 'B)
|
|
(SETF (GETHASH 'C FOO) 'D)
|
|
(NOT
|
|
(PSETF
|
|
(GETHASH 'A FOO)
|
|
(GETHASH 'C FOO)
|
|
(GETHASH 'C FOO)
|
|
(GETHASH 'A FOO)))
|
|
(EQUAL (GETHASH 'A FOO) 'D)
|
|
(EQUAL (GETHASH 'C FOO) 'B)))
|
|
(DO-TEST PSETF-SYMBOL-FUNCTION
|
|
(AND (SETF
|
|
(SYMBOL-FUNCTION 'FOO)
|
|
'(LAMBDA (A) NIL))
|
|
(SETF
|
|
(SYMBOL-FUNCTION 'BAR)
|
|
'(LAMBDA (B) NIL))
|
|
(NOT
|
|
(PSETF
|
|
(SYMBOL-FUNCTION 'FOO)
|
|
(SYMBOL-FUNCTION 'BAR)
|
|
(SYMBOL-FUNCTION 'BAR)
|
|
(SYMBOL-FUNCTION 'FOO)))
|
|
(EQUAL
|
|
(SYMBOL-FUNCTION 'FOO)
|
|
'(LAMBDA (B) NIL))
|
|
(EQUAL
|
|
(SYMBOL-FUNCTION 'BAR)
|
|
'(LAMBDA (A) NIL))))
|
|
(DO-TEST PSETF-SYMBOL-VALUE
|
|
(AND (SETF (SYMBOL-VALUE 'FOO) 1)
|
|
(SETF (SYMBOL-VALUE 'BAR) 2)
|
|
(NOT
|
|
(PSETF
|
|
(SYMBOL-VALUE 'FOO)
|
|
(SYMBOL-VALUE 'BAR)
|
|
(SYMBOL-VALUE 'BAR)
|
|
(SYMBOL-VALUE 'FOO)))
|
|
(EQUAL (SYMBOL-VALUE 'FOO) 2)
|
|
(EQUAL (SYMBOL-VALUE 'BAR) 1)))
|
|
(DO-TEST PSETF-SYMBOL-PLIST
|
|
(AND (SETF (SYMBOL-PLIST 'FOO) '(A B C D))
|
|
(SETF (SYMBOL-PLIST 'BAR) '(E F G H))
|
|
(NOT
|
|
(PSETF
|
|
(SYMBOL-PLIST 'FOO)
|
|
(SYMBOL-PLIST 'BAR)
|
|
(SYMBOL-PLIST 'BAR)
|
|
(SYMBOL-PLIST 'FOO)))
|
|
(EQUAL (SYMBOL-PLIST 'FOO) '(E F G H))
|
|
(EQUAL
|
|
(SYMBOL-PLIST 'BAR)
|
|
'(A B C D))))
|
|
(DO-TEST PSETF-MACRO-FUNCTION
|
|
(AND (SETQ FOO (GENTEMP "FOO"))
|
|
(SETQ BAR (GENTEMP "BAR"))
|
|
(SETF
|
|
(MACRO-FUNCTION FOO)
|
|
'(LAMBDA
|
|
(A)
|
|
(BQUOTE (CONS (|,| A) (|,| A)))))
|
|
(SETF
|
|
(MACRO-FUNCTION BAR)
|
|
'(LAMBDA
|
|
(B)
|
|
(BQUOTE (CONS (|,| B) (|,| B)))))
|
|
(NOT
|
|
(PSETF
|
|
(MACRO-FUNCTION FOO)
|
|
(MACRO-FUNCTION BAR)
|
|
(MACRO-FUNCTION BAR)
|
|
(MACRO-FUNCTION FOO)))
|
|
(EQUAL
|
|
(MACRO-FUNCTION FOO)
|
|
'(LAMBDA
|
|
(B)
|
|
(BQUOTE (CONS (|,| B) (|,| B)))))
|
|
(EQUAL
|
|
(MACRO-FUNCTION BAR)
|
|
'(LAMBDA
|
|
(A)
|
|
(BQUOTE (CONS (|,| A) (|,| A)))))))
|
|
(DO-TEST PSETF-CHAR
|
|
(AND (SETQ FOO "A-STRING")
|
|
(SETQ BAR "B-STRING")
|
|
(NOT
|
|
(PSETF
|
|
(CHAR FOO 0)
|
|
(CHAR BAR 0)
|
|
(CHAR BAR 0)
|
|
(CHAR FOO 0)))
|
|
(EQL (CHAR FOO 0) #\B)
|
|
(EQL (CHAR BAR 0) #\A)))
|
|
(DO-TEST PSETF-SCHAR
|
|
(AND (SETQ FOO "A-STRING")
|
|
(SETQ BAR "B-STRING")
|
|
(NOT
|
|
(PSETF
|
|
(SCHAR FOO 0)
|
|
(SCHAR BAR 0)
|
|
(SCHAR BAR 0)
|
|
(SCHAR FOO 0)))
|
|
(EQL (SCHAR FOO 0) #\B)
|
|
(EQL (SCHAR BAR 0) #\A)))
|
|
(DO-TEST PSETF-BIT
|
|
(AND (SETQ FOO #*01010101)
|
|
(SETQ BAR #*10101010)
|
|
(NOT
|
|
(PSETF
|
|
(BIT FOO 1)
|
|
(BIT BAR 1)
|
|
(BIT BAR 1)
|
|
(BIT FOO 1)))
|
|
(EQL (BIT FOO 1) 0)
|
|
(EQL (BIT BAR 1) 1)))
|
|
(DO-TEST PSETF-SBIT
|
|
(AND (SETQ FOO #*01010101)
|
|
(SETQ BAR #*10101010)
|
|
(NOT
|
|
(PSETF
|
|
(SBIT FOO 1)
|
|
(SBIT BAR 1)
|
|
(SBIT BAR 1)
|
|
(SBIT FOO 1)))
|
|
(EQL (SBIT FOO 1) 0)
|
|
(EQL (SBIT BAR 1) 1)))
|
|
(DO-TEST PSETF-SUBSEQ
|
|
(AND (SETQ FOO '(1 2 3 4 5 6 7 8 9 10))
|
|
(SETQ BAR '(A B C D E F G H I J))
|
|
(NOT
|
|
(PSETF
|
|
(SUBSEQ FOO 2 4)
|
|
(SUBSEQ BAR 2 4)
|
|
(SUBSEQ BAR 2 4)
|
|
(SUBSEQ FOO 2 4)))
|
|
(EQUAL (SUBSEQ FOO 2 4) '(C D))
|
|
(EQUAL (SUBSEQ BAR 2 4) '(3 4))))
|
|
(DO-TEST PSETF-LDB
|
|
(AND (SETQ FOO 100000)
|
|
(SETQ BAR 200000)
|
|
(NOT
|
|
(PSETF
|
|
(LDB (BYTE 8 0) FOO)
|
|
(LDB (BYTE 8 0) BAR)
|
|
(LDB (BYTE 8 0) BAR)
|
|
(LDB (BYTE 8 0) FOO)))
|
|
(EQL (LDB (BYTE 8 0) FOO) 64)
|
|
(EQL (LDB (BYTE 8 0) BAR) 160)))
|
|
(DO-TEST PSETF-MASK-FIELD
|
|
(AND (SETQ FOO 100000)
|
|
(SETQ BAR 200000)
|
|
(NOT
|
|
(PSETF
|
|
(MASK-FIELD (BYTE 8 0) FOO)
|
|
(MASK-FIELD (BYTE 8 0) BAR)
|
|
(MASK-FIELD (BYTE 8 0) BAR)
|
|
(MASK-FIELD (BYTE 8 0) FOO)))
|
|
(EQL (MASK-FIELD (BYTE 8 0) FOO) 64)
|
|
(EQL (MASK-FIELD (BYTE 8 0) BAR) 160)))
|
|
(DO-TEST PSETF-APPLY-OF-AREF
|
|
(AND (SETQ
|
|
FOO
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(1 2 3 4 5 6 7 8 9 10)))
|
|
(SETQ
|
|
BAR
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(A B C D E F G H I J)))
|
|
(NOT
|
|
(PSETF
|
|
(APPLY #'AREF FOO '(1))
|
|
(APPLY #'AREF BAR '(1))
|
|
(APPLY #'AREF BAR '(1))
|
|
(APPLY #'AREF FOO '(1))))
|
|
(EQL (AREF FOO 1) 'B)
|
|
(EQL (AREF BAR 1) '2)))
|
|
(DO-TEST PSETF-EVAL-ONCE
|
|
(AND (SETQ
|
|
FOO
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(1 2 3 4 5 6 7 8 9 10)))
|
|
(SETQ
|
|
BAR
|
|
(MAKE-ARRAY
|
|
10
|
|
:INITIAL-CONTENTS
|
|
'(A B C D E F G H I J)))
|
|
(SETQ A 4)
|
|
(SETQ B 4)
|
|
(NOT
|
|
(PSETF
|
|
(AREF FOO (INCF A))
|
|
(AREF BAR B)
|
|
(AREF BAR (INCF B))
|
|
(AREF FOO A)))
|
|
(EQL (AREF FOO 5) 'E)
|
|
(EQL (AREF BAR 5) '6)))
|
|
|
|
STOP
|