diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index 4b4edd200112b47ef630c705c47d228847245ff8..add1d32d2a14aecc525002c0e9e667bcb90ee248 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.30 2002/06/05 23:17:47 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.31 2002/08/19 16:43:15 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -371,15 +371,48 @@
 		  *the-class-standard-class*)
 		 (t
 		  (class-of class)))))  
-    (flet ((fix-super (s)
-	     (cond ((classp s) s)
-		   ((not (legal-class-name-p s))
-		    (error "~S is not a class or a legal class name." s))
-		   (t
-		    (or (find-class s nil)
-			(setf (find-class s)
-			      (make-instance 'forward-referenced-class
-					     :name s)))))))      
+    (labels ((program-error (format-control &rest args)
+	       (error 'kernel:simple-program-error
+		      :format-control format-control
+		      :format-arguments args))
+	     (fix-super (s)
+	       (cond ((classp s) s)
+		     ((not (legal-class-name-p s))
+		      (program-error "~S is not a class or a legal ~
+				      class name." s))
+		     (t
+		      (or (find-class s nil)
+			  (setf (find-class s)
+				(make-instance 'forward-referenced-class
+					       :name s)))))))
+      ;;
+      ;; CLHS: signal PROGRAM-ERROR, if
+      ;; (a) there are any duplicate slot names
+      ;; (b) any of the slot options :ALLOCATION, :INITFORM, :TYPE, or
+      ;; :DOCUMENTATION appears more than one in a single slot description.
+      (loop for (slot . more) on (getf initargs :direct-slots)
+	    for slot-name = (getf slot :name)
+	    if (some (lambda (s) (eq slot-name (getf s :name))) more) do
+	      (program-error "More than one direct slot with name ~S."
+			     slot-name)
+	    else do
+	      (loop for (option value . more) on slot by #'cddr
+		    when (and (member option '(:allocation :type :initform
+					       :documentation))
+			      (not (eq unsupplied
+				       (getf more option unsupplied)))) do
+		      (program-error "Duplicate slot option ~S for slot ~S."
+				     option slot-name)))
+      ;;
+      ;; CLHS: signal PROGRAM-ERROR, if an initialization argument name
+      ;; appears more than once in :DEFAULT-INITARGS class option.
+      (loop for (initarg . more) on (getf initargs :direct-default-initargs)
+	    for name = (car initarg) 
+	    when (some (lambda (a) (eq (car a) name)) more) do
+	      (program-error "Duplicate initialization argument ~
+                              name ~S in :default-initargs of class ~A."
+			     name class))
+      ;;
       (loop (unless (remf initargs :metaclass) (return)))
       (loop (unless (remf initargs :direct-superclasses) (return)))
       (values meta