From 2ff7f7e72730bd5c43f259b7ecf094fbd75ef294 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Wed, 21 Jan 2009 17:29:08 +0000
Subject: [PATCH] 1.0.24.47: Fix 1.0.21.29 regression with enums in structs.

This is not the most elegant of fixes, but arrange to return the old
structure where applicable, and make incompatible mentions cause a
CERROR with clobber continue semantics, to parallel what I think is the
logic in the union/struct case.
---
 NEWS                         |    2 ++
 src/code/host-alieneval.lisp |   12 ++++++++++--
 tests/foreign.test.sh        |   25 +++++++++++++++++++++++++
 version.lisp-expr            |    2 +-
 4 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/NEWS b/NEWS
index 767cb73..ff82ae2 100644
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,8 @@ changes in sbcl-1.0.25 relative to 1.0.24:
     longer reuses the functional from the previous expansion site.
   * bug fix: DEFTYPE no longer breaks on bodies consisting of a single
     unquoted symbol. Regression from 1.0.22.8. (reported by Ariel Badichi)
+  * bug fix: named ENUMs in multiply-referenced alien record types no longer
+    cause an implied type redefinition.  Regression from 1.0.21.29.
   * improvements to the Windows port:
     ** SB-BSD-SOCKETS now works from saved cores as well. (reported by Stephen
        Westfold, thanks to Rudi Schlatte)
diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index 920f616..267a652 100644
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -658,8 +658,16 @@
                  (auxiliary-alien-type :enum name env)
                (when old-p
                  (unless (alien-type-= result old)
-                   (warn "redefining alien enum ~S" name))))
-             (setf (auxiliary-alien-type :enum name env) result))
+                   (cerror "Continue, clobbering the old definition"
+                           "Incompatible alien enum type definition: ~S" name)
+                   (setf (alien-type-from old) (alien-type-from result)
+                         (alien-type-to old) (alien-type-to result)
+                         (alien-type-kind old) (alien-type-kind result)
+                         (alien-type-offset old) (alien-type-offset result)
+                         (alien-type-signed old) (alien-type-signed result)))
+                 (setf result old))
+               (unless old-p
+                 (setf (auxiliary-alien-type :enum name env) result))))
            result))
         (name
          (multiple-value-bind (result found)
diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh
index 9fff522..c9989bc 100644
--- a/tests/foreign.test.sh
+++ b/tests/foreign.test.sh
@@ -14,7 +14,9 @@
 # absolutely no warranty. See the COPYING and CREDITS files for
 # more information.
 
+. ./expect.sh
 . ./subr.sh
+
 use_test_subdirectory
 
 echo //entering foreign.test.sh
@@ -371,5 +373,28 @@ run_sbcl <<EOF
 EOF
 check_status_maybe_lose "struct offsets" $?
 
+cat > $TEST_FILESTEM.alien.enum.lisp <<EOF
+(define-alien-type foo-flag
+  (enum foo-flag-
+    (:a 1)
+    (:b 2)))
+
+(define-alien-type bar
+  (struct bar
+    (foo-flag foo-flag)))
+
+(define-alien-type barp
+  (* bar))
+
+(defun foo (x)
+  (declare (type (alien barp) x))
+  x)
+
+(defun bar (x)
+  (declare (type (alien barp) x))
+  x)
+EOF
+expect_clean_compile $TEST_FILESTEM.alien.enum.lisp
+
 # success convention for script
 exit $EXIT_TEST_WIN
diff --git a/version.lisp-expr b/version.lisp-expr
index 9793066..5d0da1f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.24.46"
+"1.0.24.47"
-- 
1.7.10.4