From a6788d0b34e826bccb6e169cb1df461d80783d1d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 27 Apr 2001 01:06:43 +0000
Subject: [PATCH] .

original commit: 35ee9f2fa200eeabd04613ec2cc10f3d0ef69241
---
 collects/mzlib/class.ss            | 16 ++++++++--------
 collects/tests/mzscheme/unit.ss    |  2 +-
 collects/tests/mzscheme/unitsig.ss |  2 +-
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss
index 267d5ef..6ccb0db 100644
--- a/collects/mzlib/class.ss
+++ b/collects/mzlib/class.ss
@@ -1332,7 +1332,7 @@
 
 		   (lambda (this super-init args) 
 		     (unless (null? args)
-		       (obj-error "make-object" "unused initialization arguments: ~e" args))
+		       (obj-error 'make-object "unused initialization arguments: ~e" args))
 		     (void))
 
 		   #t)) ; no super-init
@@ -1402,7 +1402,7 @@
 	  (when by-pos-only?
 	    (unless (null? named-args)
 	      (obj-error 
-	       "make-object" 
+	       'make-object
 	       "class has only by-position initializers, but given keyword-based arguments: ~e~a" 
 	       named-args
 	       (for-class (class-name c)))))
@@ -1412,7 +1412,7 @@
 				(let loop ([al by-pos-args][nl (class-init-args c)])
 				  (cond
 				   [(null? al) named-args]
-				   [(null? nl) (obj-error "make-object" "too many initialization arguments: ~e~a" 
+				   [(null? nl) (obj-error 'make-object "too many initialization arguments: ~e~a" 
 							  by-pos-args
 							  (for-class (class-name c)))]
 				   [else (cons (cons (car nl) (car al))
@@ -1425,7 +1425,7 @@
 		(let loop ([l named-args])
 		  (unless (null? (cdr l))
 		    (if (assq (caar l) (cdr l))
-			(obj-error "make-object" "duplicate initialization argument: ~a in: ~e~a"
+			(obj-error 'make-object "duplicate initialization argument: ~a in: ~e~a"
 				   (caar l)
 				   named-args
 				   (for-class (class-name c)))
@@ -1436,7 +1436,7 @@
 	       ;; ----- This is the super-init function -----
 	       (lambda (ignore-false by-pos-args new-named-args)
 		 (when inited?
-		   (obj-error "make-object" "superclass already initialized by class initialization~a"
+		   (obj-error 'make-object "superclass already initialized by class initialization~a"
 			      (for-class (class-name c))))
 		 (set! inited? #t)
 		 (let ([named-args (if by-pos-only?
@@ -1452,7 +1452,7 @@
 		   (loop (vector-ref (class-supers c) (sub1 (class-pos c))) by-pos-args named-args)))
 	       named-args)
 	      (unless inited?
-		(obj-error "make-object" "superclass initialization not invoked by initialization~a"
+		(obj-error 'make-object "superclass initialization not invoked by initialization~a"
 			   (for-class (class-name c))))))))
       o))
 
@@ -1463,14 +1463,14 @@
 	  (cond
 	   [a (cdr a)]
 	   [default (default)]
-	   [else (obj-error "make-object" "no argument for required init variable: ~a~a" name
+	   [else (obj-error 'make-object "no argument for required init variable: ~a~a" name
 			    (if class-name (format " in class: ~a" class-name) ""))]))
 	;; By-position mode
 	(cond
 	 [(< name (length arguments))
 	  (list-ref arguments name)]
 	 [default (default)]
-	 [else (obj-error "make-object" "too few initialization arguments")])))
+	 [else (obj-error 'make-object "too few initialization arguments")])))
 
   (define (extract-rest-args skip arguments)
     (if (< skip (length arguments))
diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/mzscheme/unit.ss
index 78a3b0a..de9a2fd 100644
--- a/collects/tests/mzscheme/unit.ss
+++ b/collects/tests/mzscheme/unit.ss
@@ -205,7 +205,7 @@
 	       (export)
 	       (define (filter v)
 		 (if (procedure? v)
-		     `(proc: ,(object-name v))
+		     `(proc: ,(syntax-e (object-name v)))
 		     v))
 	       (display 
 		(map filter (list x v struct:a y make-x x? x-z both))
diff --git a/collects/tests/mzscheme/unitsig.ss b/collects/tests/mzscheme/unitsig.ss
index d2902f0..c0c44ba 100644
--- a/collects/tests/mzscheme/unitsig.ss
+++ b/collects/tests/mzscheme/unitsig.ss
@@ -298,7 +298,7 @@
   (let ([p (open-output-string)]
 	[filter (lambda (v)
 		  (if (procedure? v)
-		      `(proc: ,(object-name v))
+		      `(proc: ,(syntax-e (object-name v)))
 		      v))])
     (invoke-unit/sig
      (compound-unit/sig