From e67b821adb99db3f4c3f63a9a199b3b9d5a7f9bb Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 12 Jun 2002 14:48:19 +0000
Subject: [PATCH] .

original commit: b90d5cb4e3a155b8b1945653234e77a2f99e78ac
---
 collects/mzlib/compat.ss          | 44 ++++++++++++++-----------------
 collects/tests/mzscheme/compat.ss | 24 +++++++++++++++++
 2 files changed, 44 insertions(+), 24 deletions(-)
 create mode 100644 collects/tests/mzscheme/compat.ss

diff --git a/collects/mzlib/compat.ss b/collects/mzlib/compat.ss
index 60ed01b..3cb804f 100644
--- a/collects/mzlib/compat.ss
+++ b/collects/mzlib/compat.ss
@@ -34,30 +34,26 @@
 
   (define real-time current-milliseconds)
 
-  (define getprop (void))
-  (define putprop (void))
-  (let ([table (make-hash-table)])
-    (letrec ([gp
-	      (case-lambda
-	       [(k prop) (gp k prop #f)]
-	       [(k prop def)
-		(let ([al (hash-table-get table k (lambda () #f))])
-		  (if al
-		      (let ([v (assq prop al)])
-			(if v
-			    (cdr v)
-			    def))
-		      def))])]
-	     [pp
-	      (lambda (k prop nv)
-		(let ([al (hash-table-get table k (lambda () '()))])
-		  (let ([v (assq prop al)])
-		    (if v
-			(set-cdr! v nv)
-			(hash-table-put! table k (cons (cons prop nv) al))))))])
-      (set! getprop gp)
-      (set! putprop pp)))
-  
+  (define table (make-hash-table))
+  (define getprop
+    (case-lambda
+     [(k prop) (getprop k prop #f)]
+     [(k prop def)
+      (let ([al (hash-table-get table k (lambda () #f))])
+	(if al
+	    (let ([v (assq prop al)])
+	      (if v
+		  (cdr v)
+		  def))
+	    def))]))
+  (define putprop
+    (lambda (k prop nv)
+      (let ([al (hash-table-get table k (lambda () '()))])
+	(let ([v (assq prop al)])
+	  (if v
+	      (set-cdr! v nv)
+	      (hash-table-put! table k (cons (cons prop nv) al)))))))
+
   ;; Chez's new-cafe
   (define new-cafe 
     (letrec ([nc
diff --git a/collects/tests/mzscheme/compat.ss b/collects/tests/mzscheme/compat.ss
new file mode 100644
index 0000000..2d084d3
--- /dev/null
+++ b/collects/tests/mzscheme/compat.ss
@@ -0,0 +1,24 @@
+
+
+(load-relative "loadtest.ss")
+
+(SECTION 'compat)
+
+(require (lib "compat.ss"))
+
+(define-structure (add left right) ([sum (+ left right)]))
+(test 9 add-sum (make-add 3 6))
+
+
+(test #f getprop 'hello-world 'any)
+(test 'oops getprop 'hello-world 'any 'oops)
+(test #f getprop 'hello-world 'any)
+(test (void) putprop 'hello-world 'any 'aha)
+(test 'aha getprop 'hello-world 'any)
+(test 'aha getprop 'hello-world 'any 'oops)
+(test #f getprop 'hello-world 'many)
+(test 'oops getprop 'hello-world 'many 'oops)
+(test #f getprop 'bye-world 'any)
+(test 'oops getprop 'bye-world 'any 'oops)
+
+(report-errs)