We'll define tests as we go through each part of the types
module.
<<Types>>=
<<Tests for types>>
@ 
Tests get added to a test suite for types which
is added to the main max test suite.
<<Types>>=
<<Create a test suite for types>>
@ 
<<Create a test suite for types>>=
(add-test
        (make-test-suite
                "Type Test Suite"
                "Test suite for types"
                <<Types test suite items>>
        )
        max-test-suite
)
@ 
<<Tests for types>>=
; Type of types must be the type for itself
(defmethod sos-test ((sf nullfix))
        (unless (eq (addr-type *types*) (addr-value *types*))
                (failure "Type of types is not the type for itself")
        )
)
@ 
<<Types test suite items>>=
                ("Type of types" 'nullfix
                 :test-thunk 'sos-test)
@ 
We'll implement the address such that the test succeeds.
Let's write some tests for the sum types to get some idea of the
interface they'll need.
<<Tests for types>>=
<<Sum type tests>>
@ 
<<Sum type tests>>=
(def-test-fixture type-sum-fix ()
        (<<Sum types test fixture slots>>)
        (:documentation "Fixture for testing type-sum")
)

(defmethod setup ((sf type-sum-fix))
        <<Sum types test fixture initialization>>
)
@ 
Create an enumerated type containing some values.  This type will be used to test sum types.
<<Sum types test fixture slots>>=
         (sc-races :accessor sc-races)
         (zerg :accessor zerg)
         (protoss :accessor protoss)
         (terran :accessor terran)
@ 
<<Sum types test fixture initialization>>=
        (setf (sc-races sf) (make-type :key 'SC-RACES))
        (setf (zerg sf) (make-address (sc-races sf) :key 'ZERG))
        (setf (protoss sf) (make-address (sc-races sf) :key 'PROTOSS))
        (setf (terran sf) (make-address (sc-races sf) :key 'TERRAN))
@ 
Create the sum of the new enumerated type and boolean.  Since the
enumerated type was called SC-RACES we call the new sum a BOOLRACE
(Values in this type can be either Booleans or SC Races).
<<Sum types test fixture slots>>=
        (mysum :accessor mysum)
@ 
<<Sum types test fixture initialization>>=
        (setf (mysum sf) (type-sum *boolean-type* (sc-races sf)))
@
Now, get all the functions that convert the member types to the
new sum type.
<<Sum types test fixture slots>>= 
         (myfuncset :accessor myfuncset)
@
<<Sum types test fixture initialization>>=
        ; Get a max set of functions that return one of our new
        ; BOOLRACE objects
        (setf (myfuncset sf) (get-constructors (mysum sf)))
        ; Get the list of domains that these functions take
        (setf (mydomlist sf) nil)
@ 
Do a fancy mapping to obtain a set of types that
can be converted to our new sum.  These are 
the domains of the functions in the previous step.
<<Sum types test fixture slots>>= 
         (mydomlist :accessor mydomlist)
@ 
<<Sum types test fixture initialization>>=
        (mapset #'(lambda (func)
                (setf (mydomlist sf) 
                        (cons (function-apply *domain* func)
                        (mydomlist sf))
                ))
                (myfuncset sf)
        )
@ 
After all that work, we can verify that the conversion functions
are from the correct types.
<<Sum type tests>>=
(defmethod type-sum-bool-boolrace ((sf type-sum-fix))
        (unless (member *boolean-type* (mydomlist sf) :test #'addr-equal)
                (failure "Can't find a function taking a boolean returning a BOOLRACE")
        )
)

(defmethod type-sum-scrace-boolrace ((sf type-sum-fix))
        (unless (member (sc-races sf) (mydomlist sf) :test #'addr-equal)
                (failure "Can't find a function taking an sc-race returning a BOOLRACE")
        )
)
@ 
Add the tests for sum types to the types test suite.
<<Types test suite items>>=
                ("function Boolean -> BOOLRACE exists" 'type-sum-fix
                 :test-thunk 'type-sum-bool-boolrace)
                ("function SC-RACE -> BOOLRACE exists" 'type-sum-fix
                 :test-thunk 'type-sum-scrace-boolrace)

@
Let's define some tests on product types to see how they should behave.
<<Tests for types>>=
<<Product type tests>>
@
Before we can define tests, we need a test fixture and an
initialization method for the test fixture.  We'll take advantage of
literate programming to add slots to the fixture and initialize them
right by the tests that use those slots, instead of jumping around.
<<Product type tests>>=
(def-test-fixture product-fix ()
        (<<Product type test fixture slots>>
        )
        (:documentation "Fixture for type product testing")
)

(defmethod setup ((pf product-fix))
        <<Product type test fixture initialization>>
)
@
Ok, now we're ready to define some tests.  
We'll take the product of Boolean X Boolean, and store its address in
[[twobooltype]].
<<Product type test fixture slots>>=
        (twobooltype :accessor twobooltype)
@ 
<<Product type test fixture initialization>>=
        (setf (twobooltype pf) (type-product *boolean-type* *boolean-type*))
@ 
Now we'll try and retrieve a list of factor types from the product type address.
<<Product type test fixture slots>>=
         (factlist :accessor factlist)
@ 
<<Product type test fixture initialization>>=
        (setf (factlist pf) (product-types (twobooltype pf)))
@
Now we'll compare what we got out with what we put in.  Did we reap what we sowed?
<<Product type tests>>=
(defmethod test-prod-1 ((pf product-fix))
        (unless (addr-equal (car (factlist pf)) *boolean-type*)
                (failure "First dim in bool X bool is not bool")
        )
)       

(defmethod test-prod-2 ((pf product-fix))
        (unless (addr-equal (cadr (factlist pf)) *boolean-type*)
                (failure "Second dim in bool X bool is not bool")
        )
)       
@ 
<<Types test suite items>>=
                ("Type Product 1st type type" 'product-fix
                 :test-thunk 'test-prod-1)
                ("Type Product 2nd type type" 'product-fix
                 :test-thunk 'test-prod-2)
@
Now we'll create an address in our new product type.  Here's the slot to store it in:
<<Product type test fixture slots>>=
         (twobooladdr :accessor twobooladdr) ; an address in twobooltype
@
And here's the assignment.
<<Product type test fixture initialization>>=
        (setf (twobooladdr pf) (make-product-addr (twobooltype pf) (list true false)))
@

This would be a good time to test that the type of the address is our product type.

<<Product type tests>>=
(defmethod test-prod-addr ((pf product-fix))
        (unless (eq (addr-type (twobooladdr pf)) (addr-value (twobooltype pf)))
                (failure "Product address is not of the product type")
        )
)
@ 
<<Types test suite items>>=
        ("Address type of a product address" 'product-fix
         :test-thunk 'test-prod-addr)
@
The remaining thing that we will test is extracting the values of the factor types
from the product address.  The interface currently returns these back as a list,
just as we specified them.

<<Product type test fixture slots>>=
         (twoboolvals :accessor twoboolvals) ; list of two boolean addresses
@ 
<<Product type test fixture initialization>>=
        (setf (twoboolvals pf) (product-values (twobooladdr pf)))
@ 
<<Product type tests>>=
; These also test the type of the values (addr-equal compares types and values)
(defmethod test-prod-val-1 ((pf product-fix))
        (unless (addr-equal true (car (twoboolvals pf)))
                (failure "Didn't get out what we put in 1st value")
        )
)

(defmethod test-prod-val-2 ((pf product-fix))
        (unless (addr-equal false (cadr (twoboolvals pf)))
                (failure "Didn't get out what we put in 2nd value")
        )
)
@
<<Types test suite items>>= 
                ("Type Product 1st value" 'product-fix
                 :test-thunk 'test-prod-val-1)
                ("Type Product 2nd value" 'product-fix
                 :test-thunk 'test-prod-val-2)
@ 
Now we can define the interface for product types based on the
behavior we decided on above.