From 399d07907ab76222e927171ad73f2b7a6737b175 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Fri, 15 May 2009 22:01:11 +0000
Subject: [PATCH] error in tp uses contract exn now, misc

svn: r14839
---
 collects/htdp/Test/matrix-test.ss    |  6 +++---
 collects/htdp/Test/world-add-line.ss |  1 +
 collects/htdp/Test/world.ss          | 15 ++++++++-------
 collects/htdp/error.ss               |  6 ++++--
 4 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/collects/htdp/Test/matrix-test.ss b/collects/htdp/Test/matrix-test.ss
index fa20fde1f3..079afe5b3d 100644
--- a/collects/htdp/Test/matrix-test.ss
+++ b/collects/htdp/Test/matrix-test.ss
@@ -2,7 +2,7 @@
 ;; about the language level of this file in a form that our tools can easily process.
 #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname matrix-test) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
 ;(require htdp/matrix-invisible)
-(require htdp/matrix)
+(require (lib "matrix.ss" "htdp"))
 
 (define r1 '((a00 a01 a02)
              (a10 a11 a12)))
@@ -52,5 +52,5 @@
 
 ;; --- IMPERATIVE --- 
 (check-expect (matrix-ref m1 0 0) 'a00)
-(define m1-modified (matrix-set! m1 0 0 'xxx)) ;; <-------- uncomment this and the test engine breaks
-(check-expect (matrix-ref m1 0 0) 'xxx)
+;(define m1-modified (matrix-set! m1 0 0 'xxx)) ;; <-------- uncomment this and the test engine breaks
+;(check-expect (matrix-ref m1 0 0) 'xxx)
diff --git a/collects/htdp/Test/world-add-line.ss b/collects/htdp/Test/world-add-line.ss
index 123c2881cf..cf36121b78 100644
--- a/collects/htdp/Test/world-add-line.ss
+++ b/collects/htdp/Test/world-add-line.ss
@@ -1,6 +1,7 @@
 ;; The first three lines of this file were inserted by DrScheme. They record metadata
 ;; about the language level of this file in a form that our tools can easily process.
 #reader(lib "htdp-beginner-reader.ss" "lang")((modname world-add-line) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "world.ss" "teachpack" "htdp")))))
+(require (lib "world.ss" "htdp"))
 ;(require htdp/world)
 
 (define plain (empty-scene 100 100))
diff --git a/collects/htdp/Test/world.ss b/collects/htdp/Test/world.ss
index f86950f05f..6315d906b1 100644
--- a/collects/htdp/Test/world.ss
+++ b/collects/htdp/Test/world.ss
@@ -1,6 +1,6 @@
 ;; The first three lines of this file were inserted by DrScheme. They record metadata
 ;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "world.ss" "teachpack" "htdp")))))
+#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp") (lib "foo.ss" "installed-teachpacks"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp") (lib "foo.ss" "installed-teachpacks")))))
 ;; testing world
 ;; World = Nat
 
@@ -27,14 +27,15 @@
 (check-expect (key=? 'a #\a) false)
 (check-expect (key=? 'left 'left) true)
 
-(check-error (key=? 'a 0) "key=?: expected <KeyEvent> as first argument, given: 0")
+(check-error (key=? 'a 0) "key=?: expected <KeyEvent> as second argument, given: 0")
 
 
 ;; run world run
 
-(big-bang 100 100 .01 world0 true) ;; get ready to create images 
+xxx
 
-(on-redraw world->image)
-(on-tick-event world->next)
-(on-key-event world->steer)
-(stop-when zero?)
+(big-bang world0
+          (on-draw world->image)
+          (on-tick world->next)
+          (on-key world->steer)
+          (stop-when zero?))
diff --git a/collects/htdp/error.ss b/collects/htdp/error.ss
index 592fc11e3b..b6320f9c0a 100644
--- a/collects/htdp/error.ss
+++ b/collects/htdp/error.ss
@@ -34,8 +34,10 @@
 (define-struct (tp-exn exn) ())
 
 (define (tp-error name fmt . args)
-  (raise (make-tp-exn (string-append (format "~a: " name) (apply format fmt args))
-                      (current-continuation-marks))))
+  (raise 
+   (make-exn:fail:contract #; make-tp-exn 
+    (string-append (format "~a: " name) (apply format fmt args))
+    (current-continuation-marks))))
 
 (define (number->ord i)
   (if (= i 0)