diff --git a/collects/tests/deinprogramm/contract.ss b/collects/tests/deinprogramm/contract.ss
new file mode 100644
index 0000000000..f450d55a38
--- /dev/null
+++ b/collects/tests/deinprogramm/contract.ss
@@ -0,0 +1,264 @@
+#lang scheme/base
+
+(provide all-contract-tests)
+
+(require (planet schematics/schemeunit:3)
+	 deinprogramm/contract/contract
+	 deinprogramm/contract/contract-syntax)
+
+(require scheme/promise)
+
+(define integer (make-predicate-contract 'integer integer? 'integer-marker))
+(define boolean (make-predicate-contract 'boolean boolean? 'boolean-marker))
+(define %a (make-type-variable-contract 'a 'a-marker))
+(define %b (make-type-variable-contract 'b 'b-marker))
+
+(define-syntax say-no
+  (syntax-rules ()
+    ((say-no ?body ...)
+     (let/ec exit
+       (call-with-contract-violation-proc
+	(lambda (obj contract message blame)
+	  (exit 'no))
+	(lambda ()
+	  ?body ...))))))
+
+(define-syntax failed-contract
+  (syntax-rules ()
+    ((say-no ?body ...)
+     (let/ec exit
+       (call-with-contract-violation-proc
+	(lambda (obj contract message blame)
+	  (exit contract))
+	(lambda ()
+	  ?body ...))))))
+
+(define contract-tests
+  (test-suite
+   "Tests for contract combinators"
+
+   (test-case
+    "flat"
+    (check-equal? (say-no (apply-contract integer 5)) 5)
+    (check-equal? (say-no (apply-contract integer "foo")) 'no))
+
+   (test-case
+    "list"
+    (define integer-list (make-list-contract 'integer-list integer #f))
+    (check-equal? (say-no (apply-contract integer-list '(1 2 3)))
+		  '(1 2 3))
+    (check-equal? (say-no (apply-contract integer-list '#f))
+		  'no)
+    (check-eq? (failed-contract (apply-contract integer-list '(1 #f 3)))
+	       integer))
+
+   (test-case
+    "list-cached"
+    (define integer-list (make-list-contract 'integer-list integer #f))
+    (define boolean-list (make-list-contract 'integer-list boolean #f))
+    (define l '(1 2 3))
+    (define foo "foo")
+    (define no '(1 #f 3))
+    (define no2 '(1 #f 3))
+    (define integer-list->bool (make-procedure-contract 'integer-list->bool (list integer-list) boolean 'int->bool-marker))
+
+    (check-equal? (say-no (apply-contract integer-list l))
+		  '(1 2 3))
+    (check-equal? (say-no (apply-contract integer-list l))
+		  '(1 2 3))
+    (check-equal? (say-no (apply-contract boolean-list l))
+		  'no)
+    (check-equal? (say-no (apply-contract integer-list foo))
+		  'no)
+    (check-equal? (say-no (apply-contract integer-list foo))
+		  'no)
+    (check-eq? (failed-contract (apply-contract integer-list no))
+	       integer)
+    (check-eq? (failed-contract (apply-contract integer-list no))
+	       integer)
+
+    (let ((proc (say-no (apply-contract integer-list->bool (lambda (l) (even? (car l)))))))
+      (check-equal? (say-no (proc no)) 'no)
+      (check-equal? (say-no (proc no)) 'no)
+      (check-equal? (say-no (proc no2)) 'no)
+      (check-equal? (say-no (proc no2)) 'no))
+    )
+ 
+   (test-case
+    "mixed"
+    (define int-or-bool (make-mixed-contract 'int-or-bool
+					     (list integer
+						   boolean)
+					     'int-or-bool-marker))
+    (check-equal? (say-no (apply-contract int-or-bool #f))
+		  #f)
+    (check-equal? (say-no (apply-contract int-or-bool 17))
+		  17)
+    (check-equal? (say-no (apply-contract int-or-bool "foo"))
+		  'no))
+
+   (test-case
+    "combined"
+    (define octet (make-combined-contract
+		   'octet
+		   (list
+		    integer
+		    (make-predicate-contract '<256
+					     (delay (lambda (x)
+						      (< x 256)))
+					     '<256-marker)
+		    (make-predicate-contract 'non-negative
+					     (delay (lambda (x)
+						      (>= x 0)))
+					     'non-negative-marker))
+		   'octet-marker))
+    (check-equal? (say-no (apply-contract octet #f))
+		  'no)
+    (check-equal? (say-no (apply-contract octet 17))
+		  17)
+    (check-equal? (say-no (apply-contract octet 0))
+		  0)
+    (check-equal? (say-no (apply-contract octet -1))
+		  'no)
+    (check-equal? (say-no (apply-contract octet 255))
+		  255)
+    (check-equal? (say-no (apply-contract octet 256))
+		  'no)
+    (check-equal? (say-no (apply-contract octet "foo"))
+		  'no))
+
+   (test-case
+    "case"
+    (define foo-or-bar (make-case-contract 'foo-or-bar '("foo" "bar") 'foo-or-bar-marker))
+    (check-equal? (say-no (apply-contract foo-or-bar #f))
+		  'no)
+    (check-equal? (say-no (apply-contract foo-or-bar "foo"))
+		    "foo")
+    (check-equal? (say-no (apply-contract foo-or-bar "bar"))
+		  "bar"))
+
+   (test-case
+    "procedure"
+    (define int->bool (make-procedure-contract 'int->bool (list integer) boolean 'int->bool-marker))
+    (check-equal? (say-no (apply-contract int->bool #f))
+		  'no)
+    (check-equal? (say-no (apply-contract int->bool (lambda () "foo")))
+		  'no)
+    (check-equal? (say-no (apply-contract int->bool (lambda (x y) "foo")))
+		  'no)
+    (let ((proc (say-no (apply-contract int->bool (lambda (x) (odd? x))))))
+      (check-pred procedure? proc)
+      (check-equal? (proc 15) #t)
+      (check-equal? (proc 16) #f)
+      (check-equal? (say-no (proc 12 15)) 'no)
+      (check-equal? (say-no (proc "foo")) 'no))
+    (let ((proc (say-no (apply-contract int->bool (lambda (x) (+ x 1))))))
+      (check-equal? (say-no (proc 12)) 'no)))
+
+   (test-case
+    "type variable - simple"
+    (check-equal? (say-no (apply-contract %a #f)) #f)
+    (check-equal? (say-no (apply-contract %a 15)) 15))
+   
+   (test-case
+    "type variable - list"
+    (define a-list (make-list-contract 'a-list %a #f))
+    (check-equal? (say-no (apply-contract a-list '(1 2 3)))
+		  '(1 2 3))
+    (check-equal? (say-no (apply-contract a-list '#f))
+		  'no)
+    (check-equal? (say-no (apply-contract a-list '(#f "foo" 5)))
+		  '(#f "foo" 5)))
+
+   (test-case
+    "apply-contract/blame"
+    (define int->bool (make-procedure-contract 'int->bool (list integer) boolean 'int->bool-marker))
+    (let ((proc (say-no (apply-contract/blame int->bool (lambda (x) (odd? x))))))
+      (check-pred procedure? proc)
+      (check-equal? (proc 15) #t)
+      (check-equal? (proc 16) #f)
+      (check-equal? (say-no (proc 12 15)) 'no)
+      (check-equal? (say-no (proc "foo")) 'no))
+    (let ((proc (say-no (apply-contract/blame int->bool (lambda (x) x)))))
+      (call-with-contract-violation-proc
+       (lambda (obj contract message blame)
+	 (check-true (syntax? blame)))
+       (lambda ()
+	 (proc 5)))))
+   ))
+
+(define contract-syntax-tests
+  (test-suite
+   "Tests for contract syntax"
+
+   (test-case
+    "predicate"
+    (define-contract integer (predicate integer?))
+    (check-equal? (say-no (apply-contract integer 5)) 5)
+    (check-equal? (say-no (apply-contract integer "foo")) 'no))
+
+   (test-case
+    "list"
+    (check-equal? (say-no (apply-contract (contract x (list %a)) 5)) 'no)
+    (check-equal? (say-no (apply-contract (contract x (list %a)) '(1 2 3))) '(1 2 3))
+    (check-equal? (say-no (apply-contract (contract x (list (predicate integer?))) '(1 2 3))) '(1 2 3))
+    (check-equal? (say-no (apply-contract (contract x (list (predicate integer?))) '(1 #f 3))) 'no))
+
+   (test-case
+    "mixed"
+    (define int-or-bool (contract (mixed integer boolean)))
+    (check-equal? (say-no (apply-contract int-or-bool #f))
+		  #f)
+    (check-equal? (say-no (apply-contract int-or-bool 17))
+		  17)
+    (check-equal? (say-no (apply-contract int-or-bool "foo"))
+		  'no))
+
+   (test-case
+    "combined"
+    (define octet (contract (combined integer
+				      (predicate (lambda (x)
+						   (< x 256)))
+				      (predicate (lambda (x)
+						   (>= x 0))))))
+    (check-equal? (say-no (apply-contract octet #f))
+		  'no)
+    (check-equal? (say-no (apply-contract octet 17))
+		  17)
+    (check-equal? (say-no (apply-contract octet 0))
+		  0)
+    (check-equal? (say-no (apply-contract octet -1))
+		  'no)
+    (check-equal? (say-no (apply-contract octet 255))
+		  255)
+    (check-equal? (say-no (apply-contract octet 256))
+		  'no)
+    (check-equal? (say-no (apply-contract octet "foo"))
+		  'no))
+
+   (test-case
+    "procedure"
+    (define int->bool (contract int->bool ((predicate integer?) -> (predicate boolean?))))
+    (check-equal? (say-no (apply-contract int->bool #f))
+		  'no)
+    (check-equal? (say-no (apply-contract int->bool (lambda () "foo")))
+		  'no)
+    (check-equal? (say-no (apply-contract int->bool (lambda (x y) "foo")))
+		  'no)
+    (let ((proc (say-no (apply-contract int->bool (lambda (x) (odd? x))))))
+      (check-pred procedure? proc)
+      (check-equal? (proc 15) #t)
+      (check-equal? (proc 16) #f)
+      (check-equal? (say-no (proc 12 15)) 'no)
+      (check-equal? (say-no (proc "foo")) 'no))
+    (let ((proc (say-no (apply-contract int->bool (lambda (x) (+ x 1))))))
+      (check-equal? (say-no (proc 12)) 'no))) 
+
+))
+
+
+(define all-contract-tests
+  (test-suite
+   "all-contract-tests"
+   contract-tests
+   contract-syntax-tests))
diff --git a/collects/tests/deinprogramm/image.ss b/collects/tests/deinprogramm/image.ss
new file mode 100644
index 0000000000..41d41ab64e
--- /dev/null
+++ b/collects/tests/deinprogramm/image.ss
@@ -0,0 +1,1037 @@
+#lang scheme/base
+
+(provide all-image-tests)
+
+(require (planet schematics/schemeunit:3)
+	 deinprogramm/image
+         (only-in lang/private/imageeq image=?)
+	 mred
+	 mzlib/class
+	 mrlib/cache-image-snip
+	 lang/posn
+	 htdp/error)
+
+
+(define-values (image-snip1 image-snip2)
+  (let ()
+    (define size 2)
+    
+    (define (do-draw c-bm m-bm)
+      (let ([bdc (make-object bitmap-dc% c-bm)])
+        (send bdc clear)
+        (send bdc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
+        (send bdc set-brush (send the-brush-list find-or-create-brush "red" 'solid))
+        (send bdc draw-rectangle 0 0 size size)
+        (send bdc set-bitmap m-bm)
+        (send bdc clear)
+        (send bdc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
+        (send bdc set-brush (send the-brush-list find-or-create-brush "black" 'solid))
+        (send bdc draw-rectangle 0 0 (/ size 2) size)
+        (send bdc set-bitmap #f)))
+    
+    (define image-snip1 
+      (let* ([c-bm (make-object bitmap% size size)]
+             [m-bm (make-object bitmap% size size #t)])
+        (do-draw c-bm m-bm)
+        (make-object image-snip% c-bm m-bm)))
+    
+    (define image-snip2 
+      (let* ([c-bm (make-object bitmap% size size)]
+             [m-bm (make-object bitmap% size size)])
+        (do-draw c-bm m-bm)
+        (send c-bm set-loaded-mask m-bm)
+        (make-object image-snip% c-bm)))
+    
+    (values image-snip1 image-snip2)))
+
+(define image-snip3 (make-object image-snip%))
+
+;; check-on-bitmap : symbol snip -> void
+;; checks on various aspects of the bitmap snips to make
+;; sure that they draw properly
+(define (check-on-bitmap snp)
+  (let-values ([(width height) (send snp get-size)])
+    (let ([bdc (make-object bitmap-dc%)]
+          [max-difference
+           (lambda (s1 s2)
+             (cond
+               [(and (zero? (bytes-length s1))
+                     (zero? (bytes-length s2)))
+                0]
+               [else
+                (apply max
+                       (map (lambda (x y) (abs (- x y))) 
+                            (bytes->list s1)
+                            (bytes->list s1)))]))])
+      
+      ;; test that no drawing is outside the snip's drawing claimed drawing area
+      (let* ([extra-space 100]
+             [bm-width (+ width extra-space)]
+             [bm-height (+ height extra-space)]
+             [bm-clip (make-object bitmap% bm-width bm-height)]
+             [bm-noclip (make-object bitmap% bm-width bm-height)]
+             [s-clip (make-bytes (* bm-width bm-height 4))]
+             [s-noclip (make-bytes (* bm-width bm-height 4))]
+             [s-trunc (make-bytes (* bm-width bm-height 4))])
+        (send bdc set-bitmap bm-clip)
+        (send bdc clear)
+        (send bdc set-clipping-rect (/ extra-space 2) (/ extra-space 2) width height) 
+        (send snp draw bdc (/ extra-space 2) (/ extra-space 2) 0 0 (+ width extra-space) (+ height extra-space) 0 0 #f)
+        (send bdc set-clipping-region #f)
+        (send bdc get-argb-pixels 0 0 (+ width extra-space) (+ height extra-space) s-clip)
+        
+        (send bdc set-bitmap bm-noclip)
+        (send bdc clear)
+        (send snp draw bdc (/ extra-space 2) (/ extra-space 2) 0 0 (+ width extra-space) (+ height extra-space) 0 0 #f)
+        (send bdc get-argb-pixels 0 0 (+ width extra-space) (+ height extra-space) s-noclip)
+        (send bdc set-bitmap #f)
+        
+        (check-equal? s-clip s-noclip)
+        
+        (send bdc set-bitmap bm-noclip)
+        (send bdc set-pen "black" 1 'transparent)
+        (send bdc set-brush "white" 'solid)
+        (send bdc draw-rectangle 0 0 (/ extra-space 2) bm-height)
+        (send bdc draw-rectangle (- bm-width (/ extra-space 2)) 0 (/ extra-space 2) bm-height)
+        (send bdc draw-rectangle 0 0 bm-width (/ extra-space 2))
+        (send bdc draw-rectangle 0 (- bm-height (/ extra-space 2)) bm-width (/ extra-space 2))
+        (send bdc get-argb-pixels 0 0 (+ width extra-space) (+ height extra-space) s-trunc)
+        
+        (check-equal? s-noclip s-trunc))
+        
+      (let ([bm-normal (make-object bitmap% (max 1 width) (max 1 height))]
+            [bm-bitmap (make-object bitmap% (max 1 width) (max 1 height))]
+            [s-normal (make-bytes (* width height 4))]
+            [s-bitmap (make-bytes (* width height 4))])
+        
+        (send bdc set-bitmap bm-normal)
+        (send bdc clear)
+        (send snp draw bdc 0 0 0 0 width height 0 0 #f)
+        (send bdc get-argb-pixels 0 0 width height s-normal)
+        (send bdc set-bitmap bm-bitmap)
+        (send bdc clear)
+        
+        ;; force the snip to switch over to bitmap mode
+        (send snp get-argb)
+        
+        (send snp draw bdc 0 0 0 0 width height 0 0 #f)
+        (send bdc get-argb-pixels 0 0 width height s-bitmap)
+        (send bdc set-bitmap #f)
+        (check-true (<= (max-difference s-normal s-bitmap) 2))))))
+
+(define red (make-color 255 0 0))
+(define blue (make-color 0 0 255))
+(define black (make-color 0 0 0))
+(define white (make-color 255 255 255))
+
+(define awhite (make-alpha-color 0 255 255 255))
+(define ablack (make-alpha-color 0 0 0 0))
+(define ared (make-alpha-color 0 255 0 0))
+(define aclr (make-alpha-color 255 0 0 0))
+
+(define-simple-check (check-image=? i1 i2)
+  (image=? i1 i2))
+
+(define-simple-check (check-not-image=? i1 i2)
+  (not (image=? i1 i2)))
+
+(define-simple-check (check-terminates val1)
+  #t)
+
+(define (add-line i x1 y1 x2 y2 color)
+  (overlay i
+	   (line (image-width i)
+		 (image-height i) 
+		 x1 y1 x2 y2 color)
+	   "left" "top"))
+
+(define (not-image-inside? i1 i2)
+  (not (image-inside? i1 i2)))
+
+;; tests that the expression
+;;  a) raises a teachpack exception record,
+;;  b) has the right argument position, and
+;;  c) has the right name.
+(define (tp-exn-pred name position)
+  (lambda (exn)
+    (and (tp-exn? exn)
+	 (let* ([msg (exn-message exn)]
+		[beg (format "~a:" name)]
+		[len (string-length beg)])
+	   (and (regexp-match position msg)
+		((string-length msg) . > . len)
+		(string=? (substring msg 0 len) beg))))))
+
+(define-syntax err/rt-name-test
+  (syntax-rules ()
+    [(_ (name . args) position)
+     (check-exn (tp-exn-pred 'name position)
+		(lambda ()
+		  (name . args)))]))
+
+(define all-image-tests
+  (test-suite
+   "Tests for images"
+
+   (test-case
+    "image?"
+    (check-pred image? (rectangle 10 10 'solid 'blue))
+    (check-pred image? (rectangle 10 10 "solid" 'blue))
+    (check-pred image? (rectangle 10 10 'outline 'blue))
+    (check-pred image? (rectangle 10 10 "outline" 'blue))
+    (check-false (image? 5)))
+  
+  (test-case
+   "color-list"
+   (check-equal? (list red)
+		 (image->color-list (rectangle 1 1 'solid 'red)))
+   (check-equal? (list blue blue blue blue)
+		 (image->color-list (rectangle 2 2 'solid 'blue))))
+
+  (test-case
+   "colors-set-up-properly"
+   (check-equal? (list (list red) (list blue) (list black) (list white))
+		 (list (image->color-list (rectangle 1 1 'solid 'red))
+		       (image->color-list (rectangle 1 1 'solid 'blue))
+		       (image->color-list (rectangle 1 1 'solid 'black))
+  		       (image->color-list (rectangle 1 1 'solid 'white)))))
+
+  (test-case
+   "color-list2"
+   (check-equal? (list blue blue blue
+		       blue blue blue
+		       blue blue blue)
+		 (image->color-list (rectangle 3 3 'solid 'blue)))
+   (check-equal? (list blue blue blue
+		       blue blue blue
+		       blue blue blue)
+		 (image->color-list (rectangle 3 3 "solid" 'blue)))
+   (check-equal? (list blue blue blue
+		       blue white blue
+		       blue blue blue)
+		 (image->color-list (rectangle 3 3 'outline 'blue))))
+
+  (test-case
+   "color-list3"
+   (check-equal? (list blue blue blue
+		       blue white blue
+		       blue blue blue)
+		 (image->color-list (rectangle 3 3 "outline" 'blue))))
+
+  (test-case
+   "color-list4"
+   (check-image=? (color-list->image (list blue blue blue blue) 2 2)
+		  (rectangle 2 2 'solid 'blue)))
+  (test-case
+   "color-list5"
+   (check-not-image=? (color-list->image (list blue blue blue blue) 2 2)
+		      (rectangle 1 4 'solid 'blue)))
+
+  (test-case
+   "color-list6"
+   (check-image=? (color-list->image (list blue blue blue blue) 1 4)
+		  (rectangle 1 4 'solid 'blue)))
+  (test-case
+   "color-list7"
+   (check-image=? (color-list->image (list 'blue 'blue 'blue 'blue) 2 2)
+		  (rectangle 2 2 'solid 'blue)))
+
+  (test-case
+   "color-list8"
+   (check-equal? 10
+		 (image-width (color-list->image '() 10 0))))
+
+  (test-case
+   "color-list9"
+   (check-equal? 0
+		 (image-height (color-list->image '() 10 0))))
+
+  (test-case
+   "color-list10"
+   (check-equal?  0
+		  (image-width (color-list->image '() 0 10))))
+
+  (test-case
+   "color-list11"
+   (check-equal? 10
+		 (image-height (color-list->image '() 0 10))))
+
+  (test-case
+   "alpha-color-list1"
+   (check-equal? (make-alpha-color 0 255 0 0)
+		 (car (image->alpha-color-list (rectangle 1 1 'solid 'red)))))
+
+  (test-case
+   "alpha-color-list2"
+   (check-equal? (make-alpha-color 0 255 0 0)
+		 (car (image->alpha-color-list (rectangle 1 1 "solid" 'red)))))
+
+  (test-case
+   "alpha-color-list3"
+   (for-each
+    (lambda (x)
+      (check-equal? x (make-alpha-color 0 255 0 0)))
+    (image->alpha-color-list (rectangle 1 1 "solid" 'red))))
+
+  (test-case
+   "alpha-color-list4"
+   (for-each
+    (lambda (x)
+      (check-equal? x (make-alpha-color 0 255 0 0)))
+    (image->alpha-color-list (rectangle 1 1 'solid 'red))))
+
+  (test-case
+   "alpha-color-list5"
+   (check-equal? (make-alpha-color 0 0 255 0)
+		 (car (image->alpha-color-list (rectangle 1 1 'solid 'green)))))
+
+  (test-case
+   "alpha-color-list6"
+   (check-equal? (make-alpha-color 0 0 0 255)
+              (car (image->alpha-color-list (rectangle 1 1 'solid 'blue)))))
+
+  (test-case
+   "alpha-color-list7"
+   (check-equal? (image-width
+		  (alpha-color-list->image
+		   (list ared aclr ared
+			 aclr aclr aclr)
+		   3
+		   2))
+		 3))
+  (test-case
+   "alpha-color-list8"
+   (check-equal? (image-height
+		  (alpha-color-list->image
+		   (list ared aclr ared
+			 aclr aclr aclr)
+		   3
+		   2))
+		 2))
+
+  (test-case
+   "alpha-color-list9"
+   (check-equal? (image->color-list
+		  (alpha-color-list->image
+		   (list ared aclr ared
+			 aclr aclr aclr)
+		   3 2))
+		 (list red   white red
+		       white white white)))
+  (test-case
+   "alpha-color-list10"
+   (check-equal? (image->color-list
+		  (overlay
+		   (rectangle 3 3 'solid 'blue)
+		   (alpha-color-list->image
+			 (list ared aclr ared
+			       aclr aclr aclr
+			       ared aclr ared)
+			 3 3)
+		   "left" "top"))
+		 (list red  blue red
+		       blue blue blue
+		       red  blue red)))
+
+  (test-case
+   "alpha-color-list11"
+   (check-equal? 10 (image-width (alpha-color-list->image '() 10 0))))
+  
+  (test-case
+   "alpha-color-list12"
+   (check-equal? 0 (image-height (alpha-color-list->image '() 10 0))))
+
+  (test-case
+   "alpha-color-list13"
+   (check-equal? 0 (image-width (alpha-color-list->image '() 0 10))))
+
+  (test-case
+   "alpha-color-list14"
+   (check-equal? 10 (image-height (alpha-color-list->image '() 0 10))))
+
+  (test-case
+   "image=?1"
+   (check-image=? (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1)
+		  (alpha-color-list->image (list (make-alpha-color 200 100 150 175)) 1 1)))
+
+  (test-case 
+   "image=?2"
+   (check-image=? (alpha-color-list->image (list (make-alpha-color 255 100 100 100)) 1 1)
+		  (alpha-color-list->image (list (make-alpha-color 255 200 200 200)) 1 1)))
+
+  (test-case
+   "image=?3"
+   (check-not-image=? (alpha-color-list->image (list (make-alpha-color 200 100 100 100)) 1 1)
+		      (alpha-color-list->image (list (make-alpha-color 200 200 200 200)) 1 1)))
+
+  (test-case
+   "image=?4"
+   (check-not-image=? (alpha-color-list->image (list (make-alpha-color 200 100 150 175)
+						     (make-alpha-color 200 100 150 175))
+					       1
+					       2)
+		      (alpha-color-list->image (list (make-alpha-color 200 100 150 175)
+						     (make-alpha-color 200 100 150 175)) 
+					       2
+					       1)))
+
+  (test-case
+   "image=?5"
+   (write (image=? (rectangle 4 4 'outline 'black) 
+		   (overlay
+		    (rectangle 4 4 'outline 'black)
+		    (circle 1 'solid 'red)
+		    1 1)))
+
+   (check-not-image=? (rectangle 4 4 'outline 'black) 
+		      (overlay
+		       (rectangle 4 4 'outline 'black)
+		       (circle 1 'solid 'red)
+		       0 0)))
+
+  (test-case 
+   "overlay"
+   (check-image=? (color-list->image (list blue red blue red) 2 2)
+		  (overlay (rectangle 2 2 'solid 'red)
+			   (rectangle 1 2 'solid 'blue)
+			   "left" "top")))
+
+  (test-case
+   "overlay/multiple"
+   (check-image=? (overlay (rectangle 6 6 'solid 'red)
+			   (overlay (rectangle 4 4 'solid 'white)
+				    (rectangle 2 2 'solid 'blue)
+				    "center" "center")
+			   "center" "center")
+		  (overlay (overlay (rectangle 6 6 'solid 'red)
+				    (rectangle 4 4 'solid 'white)
+				    "center" "center")
+			   (rectangle 2 2 'solid 'blue)
+			   "center" "center")))
+
+  (test-case
+   "overlay/empty-spaces-are-unmasked"
+   (check-image=? (color-list->image (list red red red blue) 2 2)
+		  (overlay
+		   (rectangle 2 2 'solid 'blue)
+		   (overlay (rectangle 1 2 'solid 'red)
+			    (rectangle 2 1 'solid 'red)
+			    "left" "top")
+		   "left" "top")))
+  
+  (test-case
+   "overlay/xy1"
+   (check-image=? (color-list->image (list red blue red blue) 2 2)
+		  (overlay (rectangle 2 2 'solid 'red)
+                           (rectangle 1 2 'solid 'blue)
+			   1 0)))
+
+  (test-case
+   "overlay/xy2"
+   (check-image=? (color-list->image (list red red red blue) 2 2)
+		  (overlay (rectangle 2 2 'solid 'red)
+                           (rectangle 1 1 'solid 'blue)
+			   1 1)))
+
+  (test-case
+   "overlay/xy3"
+   (check-image=? (color-list->image (list red red blue blue) 2 2)
+		  (overlay (rectangle 2 1 'solid 'red)
+                           (rectangle 2 1 'solid 'blue)
+                           0 1)))
+
+  (test-case
+   "overlay/xy/white"
+   (check-image=? (alpha-color-list->image (list ablack ablack ablack
+						 ablack awhite ablack
+						 ablack ablack ablack)
+					   3 3)
+		  (overlay (rectangle 3 3 'solid 'black)
+			   (rectangle 1 1 'solid 'white)
+			   1 1)))
+
+  (test-case
+   "color-list->image/white-in-mask"
+   (check-image=? (color-list->image (list black red   black
+					   red   red   red
+					   black red   black)
+				     3 3)
+		  (overlay (rectangle 3 3 'solid 'red)
+			   (color-list->image (list black white black
+						    white white white
+						    black white black)
+					      3 3)
+			   "left" "top")))
+
+
+  (test-case
+   "overlay"
+   (check-image=? (color-list->image (list red blue red red blue red) 3 2)
+               (overlay (rectangle 3 2 'solid 'red)
+			(rectangle 1 2 'solid 'blue)
+			1 0)))
+
+  (test-case
+   "image=?-zero1"
+   (check-image=? (rectangle 0 10 'solid 'red)
+		  (rectangle 0 10 'solid 'red)))
+  (test-case
+   "image=?-zero2"
+   (check-image=? (rectangle 0 10 'solid 'red)
+		  (rectangle 0 10 'solid 'blue)))
+  (test-case
+   "image=?-zero3"
+   (check-not-image=? (rectangle 0 5 'solid 'red)
+		      (rectangle 0 4'solid 'blue)))
+
+  (test-case
+   "image-inside?1"
+   (check image-inside?
+	  (overlay (rectangle 3 2 'solid 'red)
+		   (rectangle 1 2 'solid 'blue)
+		   1 0)
+	  (rectangle 1 2 'solid 'blue)))
+
+  (test-case
+   "image-inside?2"
+   (check not-image-inside?
+	  (overlay (rectangle 3 2 'solid 'red)
+		   (rectangle 1 2 'solid 'blue)
+		   1 0)
+	  (rectangle 1 2 'solid 'black)))
+
+  (test-case
+   "image-inside?3"
+   (check image-inside?
+	  (overlay (rectangle 3 2 'solid 'red)
+		   (rectangle 1 2 'solid 'blue)
+		   1 0)
+	  (rectangle 1 2 'solid 'red)))
+
+  (test-case
+   "image-inside?4"
+   (check not-image-inside?
+	  (overlay (rectangle 3 2 'solid 'red)
+		   (rectangle 1 2 'solid 'blue)
+		   1 0)
+	  (rectangle 2 1 'solid 'red)))
+
+  (test-case
+   "image-inside?5"
+   (check image-inside?
+	  (alpha-color-list->image (list (make-alpha-color 0 255 0 0)) 1 1)
+	  (alpha-color-list->image (list (make-alpha-color 255 0 0 0)) 1 1)))
+
+  (test-case
+   "image-inside?6"
+   (check not-image-inside?
+	  (overlay (rectangle 3 2 'solid 'red)
+		   (rectangle 1 2 'solid 'blue)
+		   1 0)
+	  (color-list->image (list blue white white) 
+			     3 1)))
+
+  (test-case
+   "image-inside?7"
+   (check image-inside?
+	  (overlay (rectangle 16 16 'solid 'red)
+		   (ellipse 6 6 'outline 'blue)
+		   2 5)
+	  (ellipse 6 6 'outline 'blue)))
+
+  (test-case
+   "image-inside?8"
+   (check image-inside?
+	  (overlay (rectangle (image-width (text "x" 12 'red))
+			      (image-height (text "x" 12 'red))
+			      'solid 
+			      'white)
+		   (text "x" 12 'red)
+		   "center" "center")
+	  (text "x" 12 'red)))
+
+  (test-case
+   "image-inside?9"
+   (check image-inside?
+	  (text "y x y" 12 'red)
+	  (text "x" 12 'red)))
+
+  (test-case
+   "find-image1"
+   (check-equal? (make-posn 2 5)
+		 (find-image (overlay (rectangle 16 16 'solid 'red)
+				      (ellipse 6 6 'outline 'blue)
+				      2 5)
+			     (ellipse 6 6 'outline 'blue))))
+
+  (test-case
+   "find-image2"
+   (check-equal? (make-posn 0 0)
+		 (find-image (rectangle 16 16 'solid 'blue)
+			     (ellipse 6 6 'outline 'blue))))
+
+  (test-case
+   "find-image3"
+   (check-equal? (make-posn 1 1)
+		 (find-image (overlay (rectangle 10 10 'solid 'blue)
+				      (ellipse 5 5 'solid 'red)
+				      1 1)
+			     (ellipse 5 5 'solid 'red))))
+
+  (test-case
+   "image-width"
+   (check-equal? 5 (image-width (rectangle 5 7 'solid 'red))))
+
+  (test-case
+   "image-height"
+   (check-equal? 7 (image-height (rectangle 5 7 'solid 'red))))
+
+  (test-case
+   "color-red"
+   (check-equal? 1 (color-red (make-color 1 2 3))))
+  
+  (test-case
+   "color-green" 
+   (check-equal? 2 (color-green (make-color 1 2 3))))
+
+  (test-case
+   "color-blue" 
+   (check-equal? 3 (color-blue (make-color 1 2 3))))
+
+  (test-case
+   "color?1"
+   (check-true (color? (make-color 1 2 3))))
+
+  (test-case
+   "color?2" 
+   (check-false (color? 10)))
+
+  (test-case
+   "image-color?1"
+   (check-pred image-color? (make-color 1 2 3)))
+
+  (test-case
+   "image-color?2"
+   (check-pred image-color? "blue"))
+
+  (test-case 
+   "image-color?3"
+   (check-pred image-color? 'blue))
+
+  (test-case 
+   "image-color?4"
+   (check-false (image-color? 10)))
+
+  (test-case
+   "image-color?5"
+   (check-false (image-color? "not-a-color")))
+
+  (test-case
+   "image-color?6" 
+   (check-false (image-color? 'not-a-color)))
+
+  (test-case
+   "line" 
+   (check image=? 
+	  (line 5 1 0 0 4 0 'red)
+	  (color-list->image (list red red red red red) 5 1))
+   (check image=?
+	  (line 1 5 0 0 0 4 'red)
+	  (color-list->image (list red red red red red) 1 5))
+
+   (check image=?
+	  (line 1 5 0 4 0 0 'red)
+	  (color-list->image (list red red red red red) 1 5))
+
+   (check image=?
+	  (line 5 1 4 0 0 0 'red)
+	  (color-list->image (list red red red red red) 5 1)))
+
+
+; note: next two tests may be platform-specific... I'm not sure.
+  ;; I developed them under macos x. -robby
+  (test-case
+   "triangle1"
+   (check image=?
+	  (triangle 3 'outline 'red)
+	  (color-list->image 
+	   (list white red   white
+		 white red   white
+		 red   white red
+		 red   red   red)
+	   3
+	   4)))
+
+  (test-case
+   "triangle2"
+   (check image=? 
+	  (triangle 3 'solid 'red)
+	  (color-list->image 
+	   (list white red   white
+		 white red   white
+		 red   red   red
+		 red   red   red)
+	   3
+	   4)))
+
+  (test-case
+   "clipping-twice-clips-both-times" 
+   (check image=?
+	  (overlay
+	   (rectangle 11 11 'solid 'green)
+	   (clip (rectangle 11 11 'solid 'red)
+		 5 5 1 1)
+	   "center" "center")
+	  (overlay
+	   (rectangle 11 11 'solid 'green)
+	   (clip (clip (rectangle 11 11 'solid 'red)
+		       3 3 2 2)
+		 2 2 1 1)
+	   "center" "center")))
+
+  (test-case
+   "solid-rect"
+   (check-on-bitmap  (rectangle 2 2 'solid 'red)))
+
+  (test-case
+   "outline-rect"
+   (check-on-bitmap (rectangle 2 2 'outline 'red)))
+  (test-case
+   "solid-ellipse"
+   (check-on-bitmap (ellipse 2 4 'solid 'red)))
+  (test-case
+   "outline-ellipse"
+   (check-on-bitmap (ellipse 2 4 'outline 'red)))
+  (test-case
+   "solid-circle"
+   (check-on-bitmap (circle 4 'solid 'red)))
+  (test-case
+   "outline-circle"
+   (check-on-bitmap (circle 4 'outline 'red)))
+
+  (test-case
+   "0solid-rect1"
+   (check-on-bitmap (rectangle 0 2 'solid 'red)))
+  (test-case
+   "0solid-rect2"
+   (check-on-bitmap (rectangle 2 0 'solid 'red)))
+  (test-case
+   "0outline-rect1"
+   (check-on-bitmap (rectangle 2 0 'outline 'red)))
+  (test-case
+   "0outline-rect2"
+   (check-on-bitmap (rectangle 0 0 'outline 'red)))
+  (test-case
+   "0solid-ellipse1"
+   (check-on-bitmap (ellipse 0 3 'solid 'red)))
+  (test-case
+   "0solid-ellipse2"
+   (check-on-bitmap (ellipse 3 0 'solid 'red)))
+  (test-case
+   "0outline-ellipse1"
+   (check-on-bitmap (ellipse 0 4 'outline 'red)))
+  (test-case
+   "0outline-ellipse2"
+   (check-on-bitmap (ellipse 2 0 'outline 'red)))
+  (test-case
+   "0solid-circle"
+   (check-on-bitmap (circle 0 'solid 'red)))
+  (test-case
+   "0outline-circle"
+   (check-on-bitmap (circle 0 'outline 'red)))
+
+  (test-case
+   "solid-triangle"
+   (check-on-bitmap (triangle 10 'solid 'red)))
+  (test-case
+   "outline-triangle"
+   (check-on-bitmap (triangle 10 'outline 'red)))
+  (test-case
+   "line"
+   (check-on-bitmap (line 10 7 0 0 9 6 'red)))
+
+
+
+  ;; (check-on-bitmap 'text (text "XX" 12 'red)) ;; this test fails for reasons I can't control ... -robby
+  (test-case
+   "overlay1"
+   (check-on-bitmap (overlay (rectangle 1 4 'solid 'blue)
+			     (rectangle 4 1 'solid 'green)
+			     "left" "top")))
+  (test-case
+   "overlay2"
+   (check-on-bitmap (overlay (rectangle 4 4 'solid 'blue)
+			     (rectangle 4 4 'solid 'green)
+			     2 2)))
+  (test-case
+   "overlay3"
+   (check-on-bitmap (overlay image-snip1
+			     (rectangle (image-width image-snip1) 
+					(image-height image-snip1)
+					'outline
+					'red)
+			     "center" "center")))
+  (test-case
+   "alpha-color-list"
+   (check-on-bitmap
+    (overlay
+     (rectangle 3 3 'solid 'blue)
+     (alpha-color-list->image
+      (list ared aclr ared
+	    aclr aclr aclr
+	    ared aclr ared)
+      3
+      3)
+     "center" "center")))
+   (test-case
+    "add-line"
+    (check-on-bitmap
+     (overlay
+      (rectangle 100 100 'solid 'black)
+      (line 100 100 -10 -10 110 110 'red)
+      0 0)))
+
+   (test-case
+    "add-line1"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       -20 -20
+	       0 0
+	       'red)))
+   (test-case
+    "add-line2"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       -20 20
+	       0 0
+	       'red)))
+   (test-case
+    "add-line3"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       20 -20
+	       0 0
+	       'red)))
+   
+   (test-case
+    "add-line4"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       20 20
+	       0 0
+	       'red))) 
+
+   (test-case
+    "add-line5"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       0 0
+	       -20 -20
+	       'red)))
+
+   (test-case
+    "add-line6"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       0 0
+	       -20 20
+	       'red)))
+
+   (test-case
+    "add-line7"
+    (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	      0 0
+	      20 -20
+	      'red))
+
+   (test-case
+    "add-line8"
+    (check-on-bitmap
+     (add-line (overlay (rectangle 11 11 'solid 'black) (rectangle 3 3 'solid 'green) "center" "center")
+	       0 0
+	       20 20
+	       'red)))
+
+   (test-case
+    "shrink"
+    (check-on-bitmap
+     (clip (rectangle 11 11 'solid 'red)
+	   5 5 1 1)))
+
+
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;;
+   ;;  test images with zero width or zero height 
+   ;;  for various things
+   ;;
+   
+   (test-case
+    "zero-width/height"
+    (check-equal? 10 (image-width (rectangle 10 0 'solid 'red)))
+    (check-equal? 0 (image-height (rectangle 10 0 'solid 'red)))
+    (check-equal? 0 (image-width (rectangle 0 10 'solid 'red)))
+    (check-equal? 10 (image-height (rectangle 0 10 'solid 'red)))
+   
+    (check-equal? 0 (image-width (text "" 12 'black)))
+    (check > (image-height (text "" 12 'black)) 0)
+
+    (check-equal? '() (image->color-list (rectangle 0 10 'solid 'red)))
+    (check-equal? '() (image->color-list (rectangle 10 0 'solid 'red)))
+    (check-equal? '() (image->color-list (rectangle 0 0 'solid 'red)))
+
+    (check-equal? '() (image->alpha-color-list (rectangle 0 10 'solid 'red)))
+    (check-equal? '() (image->alpha-color-list (rectangle 10 0 'solid 'red)))
+    (check-equal? '() (image->alpha-color-list (rectangle 0 0 'solid 'red))))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;;
+   ;;  test that the image construction functions
+   ;;  accept non-integer values (and floor them)
+   ;;
+   
+   (test-case
+    "accept-non-integer"
+    (check-equal? (image->color-list (rectangle 2 2 'solid 'blue))
+		  (image->color-list (rectangle #e2.5 2.5 'solid 'blue)))
+    (check-equal? (image->color-list (ellipse 2 2 'solid 'blue))
+		  (image->color-list (ellipse #e2.5 2.5 'solid 'blue)))
+    (check-equal? (image->color-list (circle 2 'solid 'blue))
+		  (image->color-list (circle #e2.5 'solid 'blue)))
+    (check-equal? (image->color-list (triangle 12 'solid 'blue))
+		  (image->color-list (triangle 12.5 'solid 'blue)))
+    (check-equal? (image->color-list (line 10 12 0 0 9 11 'blue))
+		  (image->color-list (line 10 12 0 0 9.5 #e11.5 'blue)))
+    (check-equal? (image->color-list (clip (rectangle 10 10 'solid 'blue) 3 3 4 4))
+		  (image->color-list
+		   (clip (rectangle 10 10 'solid 'blue)
+			 3.1
+			 3.2
+			 #e4.3
+			 4.4)))
+    (check-equal? (image->color-list (add-line (rectangle 10 10 'solid 'blue)
+					       0 0 2 2 'red))
+		  (image->color-list (add-line (rectangle 10 10 'solid 'blue)
+					       0.1 #e.2 2.1 2.2 'red))))
+
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;;
+   ;; The tests beginning with "bs-" ensure
+   ;; that the operations all can accept bitmap 
+   ;; snips as arguments
+   ;;
+   
+   (test-case
+    "accept-bitmap"
+    (check-pred image? image-snip1)
+    (check-pred image? image-snip2)
+    (check image=? image-snip1 (send image-snip1 copy))
+    (check-not-image=?
+     ;; They have different masks:
+     image-snip1 image-snip2)
+    (check-equal? 2 (image-width image-snip1))
+    (check-equal? 2 (image-width image-snip2))
+    (check-equal? 2 (image-height image-snip1))
+    (check-equal? 2 (image-height image-snip2))
+    (check image=? image-snip1 (overlay image-snip1 image-snip2 "center" "center"))
+    (check image=? image-snip1 (overlay image-snip1 image-snip2 "left" "top"))
+    (check image=?
+	   (add-line image-snip1 0 0 10 10 'green)
+	   (add-line image-snip2 0 0 10 10 'green))
+    (check image-inside? image-snip1 image-snip2)
+    (check image-inside? image-snip2 image-snip1)
+    (check-equal? (make-posn 0 0)
+		  (find-image image-snip1 image-snip2))
+    (check-equal? (make-posn 0 0)
+		  (find-image image-snip2 image-snip1))
+    (check-equal? (image->color-list image-snip1)
+		  (image->color-list image-snip2))
+    (check-equal? (image->alpha-color-list image-snip1)
+		  (image->alpha-color-list image-snip2)))
+
+
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;;
+   ;; test image-snip that doesnt' have a bitmap
+   ;;
+   
+   (test-case
+    "image-snip-no-bitmap"
+    (check-equal? 20
+		  (image-width image-snip3))
+    (overlay image-snip3 image-snip3 10 10))
+
+
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;;
+   ;; test color arguments
+   ;;
+   (test-case
+    "color-arguments"
+    (check-terminates (rectangle 10 10 'solid 'blue))
+    (check-terminates (rectangle 10 10 'solid "blue"))
+    (check-terminates (rectangle 10 10 'solid (make-color 0 0 255)))
+    (check-terminates (ellipse 10 10 'solid 'blue))
+    (check-terminates (ellipse 10 10 'solid "blue"))
+    (check-terminates (ellipse 10 10 'solid (make-color 0 0 255)))
+    (check-terminates (circle 10 'solid 'blue))
+    (check-terminates (circle 10 'solid "blue"))
+    (check-terminates (circle 10 'solid (make-color 0 0 255)))
+    (check-terminates (triangle 10 'solid 'blue))
+    (check-terminates (triangle 10 'solid "blue"))
+    (check-terminates (triangle 10 'solid (make-color 0 0 255)))
+    (check-terminates (line 10 10 0 0 9 9 'blue))
+    (check-terminates (line 10 10 0 0 9 9 "blue"))
+    (check-terminates (line 10 10 0 0 9 9 (make-color 0 0 255)))
+    (check-terminates (add-line (rectangle 1 1 'solid 'blue) 0 0 1 1 'blue))
+    (check-terminates (add-line (rectangle 1 1 'solid 'blue) 0 0 1 1 "blue"))
+    (check-terminates (add-line (rectangle 1 1 'solid 'blue) 0 0 1 1 (make-color 0 0 255)))
+    (check-terminates (text "abc" 12 'blue))
+    (check-terminates (text "abc" 12 "blue"))
+    (check-terminates (text "abc" 12 (make-color 0 0 255))))
+
+   (test-case
+    "error-message"
+    (err/rt-name-test (image-width 1) "first") 
+    (err/rt-name-test (image-height 1) "first")
+    (err/rt-name-test (overlay 1 2 "center" "center") "first")
+    (err/rt-name-test (overlay image-snip1 2 "center" "center") "second")
+    (err/rt-name-test (overlay 1 2 "center" "center") "first")
+    (err/rt-name-test (overlay image-snip1 image-snip2 "foo" "center") "third")
+    (err/rt-name-test (overlay image-snip1 image-snip2 "center" "foo") "fourth")
+    (err/rt-name-test (rectangle #f #f #f #f) "first")
+    (err/rt-name-test (rectangle 10 #f #f #f) "second")
+    (err/rt-name-test (rectangle 10 10 #f #f) "third")
+    (err/rt-name-test (rectangle 10 10 'solid #f) "fourth")
+    (err/rt-name-test (circle #f #f #f) "first")
+    (err/rt-name-test (circle 10 #f #f) "second")
+    (err/rt-name-test (circle 10 'solid #f) "third")
+    (err/rt-name-test (ellipse #f #f #f #f) "first")
+    (err/rt-name-test (ellipse 10 #f #f #f) "second")
+    (err/rt-name-test (ellipse 10 10 #f #f) "third")
+    (err/rt-name-test (ellipse 10 10 'solid #f) "fourth")
+    (err/rt-name-test (triangle #f #f #f) "first")
+    (err/rt-name-test (triangle 10 #f #f) "second")
+    (err/rt-name-test (triangle 10 'solid #f) "third")
+    (err/rt-name-test (line #f #f 0 0 0 0 #f) "first")
+    (err/rt-name-test (line 10 #f 0 0 0 0 #f) "second")
+    (err/rt-name-test (line 10 10 #f 0 0 0 #f) "third")
+    (err/rt-name-test (line 10 10 0 #f 0 0 #f) "fourth")
+    (err/rt-name-test (line 10 10 0 0 #f 0 #f) "fifth")
+    (err/rt-name-test (line 10 10 0 0 0 #f #f) "sixth")
+    (err/rt-name-test (line 10 10 0 0 0 0 #f) "seventh")
+    (err/rt-name-test (text #f #f #f) "first")
+    (err/rt-name-test (text "abc" #f #f) "second")
+    (err/rt-name-test (text "abc" 10 #f) "third")
+    (err/rt-name-test (image-inside? #f #f) "first")
+    (err/rt-name-test (image-inside? image-snip1 #f) "second")
+    (err/rt-name-test (find-image #f #f) "first")
+    (err/rt-name-test (find-image image-snip1 #f) "second")
+    (err/rt-name-test (image->color-list 1) "first")
+    (err/rt-name-test (color-list->image #f #f #f) "first")
+    (err/rt-name-test (color-list->image (list (make-color 0 0 0)) #f #f) "second")
+    (err/rt-name-test (color-list->image (list (make-color 0 0 0)) 1 #f) "third")
+    (err/rt-name-test (image->alpha-color-list #f) "first")
+    (err/rt-name-test (alpha-color-list->image #f #f #f) "first")
+    (err/rt-name-test (alpha-color-list->image (list (make-alpha-color 0 0 0 0)) #f #f) "second")
+    (err/rt-name-test (alpha-color-list->image (list (make-alpha-color 0 0 0 0)) 1 #f) "third"))
+))
diff --git a/collects/tests/deinprogramm/run-contract-tests.ss b/collects/tests/deinprogramm/run-contract-tests.ss
new file mode 100644
index 0000000000..c375180247
--- /dev/null
+++ b/collects/tests/deinprogramm/run-contract-tests.ss
@@ -0,0 +1,6 @@
+#lang scheme/base
+
+(require (planet schematics/schemeunit:3/text-ui))
+(require tests/deinprogramm/contract)
+
+(run-tests all-contract-tests)
\ No newline at end of file
diff --git a/collects/tests/deinprogramm/run-image-test.ss b/collects/tests/deinprogramm/run-image-test.ss
new file mode 100644
index 0000000000..06215561da
--- /dev/null
+++ b/collects/tests/deinprogramm/run-image-test.ss
@@ -0,0 +1,6 @@
+#lang scheme/base
+
+(require (planet schematics/schemeunit:3/text-ui))
+(require tests/deinprogramm/image)
+
+(run-tests all-image-tests)
\ No newline at end of file