[Openmcl-cvs-notifications] r8541 - /trunk/source/lib/foreign-types.lisp

[gb at clozure.com]

Author: gb
Date: Thu Feb 21 04:44:13 2008
New Revision: 8541

Log:
CERROR if conflicting :struct/:union with the same tag.

Modified:
    trunk/source/lib/foreign-types.lisp

Modified: trunk/source/lib/foreign-types.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/foreign-types.lisp (original)
+++ trunk/source/lib/foreign-types.lisp Thu Feb 21 04:44:13 2008
@@ -231,14 +231,26 @@
   (defun info-foreign-type-struct (x &optional (ftd *target-ftd*))
     (gethash (make-keyword x) (ftd-struct-definitions ftd)))
   (defun (setf info-foreign-type-struct) (val x &optional (ftd *target-ftd=
*))
-    (note-foreign-type-ordinal val ftd)
-    (setf (gethash (make-keyword x) (ftd-struct-definitions ftd)) val))
+    (let* ((name (make-keyword x)))
+      (when (gethash name (ftd-union-definitions ftd))
+        (cerror "Define ~s as a struct type"
+                "~s is already defined as a union type"
+                name)
+        (remhash name (ftd-union-definitions ftd)))
+      (note-foreign-type-ordinal val ftd)
+      (setf (gethash name (ftd-struct-definitions ftd)) val)))
 =

   (defun info-foreign-type-union (x &optional (ftd *target-ftd*))
     (gethash (make-keyword x) (ftd-union-definitions ftd)))
   (defun (setf info-foreign-type-union) (val x  &optional (ftd *target-ftd=
*))
+    (let* ((name (make-keyword x)))
+      (when (gethash name (ftd-struct-definitions ftd))
+        (cerror "Define ~s as a union type"
+                "~s is already defined as a struct type"
+                name)
+        (remhash name (ftd-struct-definitions ftd)))
     (note-foreign-type-ordinal val ftd)
-    (setf (gethash (make-keyword x) (ftd-union-definitions ftd)) val))
+    (setf (gethash name (ftd-union-definitions ftd)) val)))
 =

   (defun info-foreign-type-enum (x  &optional (ftd *target-ftd*))
     (gethash (make-keyword x) (ftd-enum-definitions ftd)))