<> <> <> <>= ; Now we'll create a fixture with some values in it.. (def-test-fixture ptrfix () ( <> ) (:documentation "Fixture for testing pointers") ) (defmethod setup ((pf ptrfix)) <> ) ;(defmethod teardown ((pf ptrfix)) t) @ Set up a test suite, test fixture, and fixture initialization method for testing pointers. Tests will be defined as we go through the pointers module. <>= (add-test (make-test-suite "Pointers Test Suite" NIL <> ) max-test-suite ) @ There's a global variable, *ptrs*, containing the address of the type of pointers. Test that *ptrs* is a type address. <>= (defmethod ptrs-type ((nf nullfix)) (unless (eq (addr-type *ptrs*) (addr-value *types*)) (failure "The type of *ptrs* is not *types*") )) @ <>= ("*ptrs* type" 'nullfix :test-thunk 'ptrs-type) @ @ The following tests demonstrate the interface to pointers. The first two fixture slots contain an enumerated type and a value in it. <>= (atype :accessor atype) (anaddr :accessor anaddr) @ <>= (setf (atype pf) (make-type :key 'TestType)) (setf (anaddr pf) (make-address (atype pf) :key 'TestAddress)) \subsection{Creating a pointer} Let's create a new pointer, specifying an initial value, and store its address in a fixture slot. <>= (aptr :accessor aptr) @ <>= ; Leaving off :key on the next two since they don't support it yet (setf (aptr pf) (make-ptr (anaddr pf))) @ Test that the new pointer is of the correct type (pointers). <>= (defmethod test-make-ptr-1 ((pf ptrfix)) (unless (addr-value-equal (addr-value *types*) (addr-type (aptr pf)) (addr-value *ptrs*) ) (failure "The type of aptr is not *ptrs*") ) ) @ <>= ("MAKE-PTR 1" 'ptrfix :test-thunk 'test-make-ptr-1) @ \subsection{Following a pointer} Test that the new pointer, APTR, created in the previous section correctly stores the value we initialized it with, ANADDR. <>= ; Use EQUAL: allow DEREF-PTR to recreate the address (defmethod test-make-ptr-2 ((pf ptrfix)) (unless (addr-equal (deref-ptr (aptr pf)) (anaddr pf)) (failure "APTR does not point at ANADDR") )) @ <>= ("MAKE-PTR 2" 'ptrfix :test-thunk 'test-make-ptr-2) @ <>= (aselfptr :accessor aselfptr) @ <>= (setf (aselfptr pf) (make-self-ptr)) @ <>= (defmethod test-self-ptr ((pf ptrfix)) (unless (addr-equal (deref-ptr (aselfptr pf)) (aselfptr pf)) (failure "MAKE-SELF-PTR failed") )) @ <>= ("MAKE-SELF-PTR" 'ptrfix :test-thunk 'test-self-ptr) @ \subsection{Changing pointers} In order to test changing a pointer, we'll need a second address to point APTR to. <>= (anotheraddr :accessor anotheraddr) @ We'll make ANOTHERADDR as a second value in the enumerated type ATYPE. <>= (setf (anotheraddr pf) (make-address (atype pf) :key 'TestAddr2)) @ Now change APTR and check if it got changed. Since we want to test the side-effect of CHANGE-PTR, we can't call CHANGE-PTR inside the test fixture initialization. We'll call it inside the test itself, and hope that the test is called after any previous tests that use the initial value of APTR. <>= (defmethod test-change-ptr ((pf ptrfix)) (change-ptr (aptr pf) (anotheraddr pf)) (unless (addr-equal (deref-ptr (aptr pf)) (anotheraddr pf)) (failure "APTR does not point at ANOTHERADDR after CHANGE-PTR") )) @ <>= ("CHANGE-PTR" 'ptrfix :test-thunk 'test-change-ptr) @