From 4d2cf7b6bcfe958beb37643acde1d29781eae7e2 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Sun, 9 Jul 2000 16:05:19 +0000
Subject: [PATCH] Enhance finalize-xep-definition to report conflicts between
 the derived function return type and the declared return type. Such conflicts
 can cause lossage so warrant reporting.

---
 compiler/ir1final.lisp | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/compiler/ir1final.lisp b/compiler/ir1final.lisp
index daaa4f4d1..99b321d7b 100644
--- a/compiler/ir1final.lisp
+++ b/compiler/ir1final.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1final.lisp,v 1.20 1994/10/31 04:27:28 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1final.lisp,v 1.21 2000/07/09 16:05:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -83,7 +83,17 @@
 	     (setf (info function type name) dtype)
 	     (setf (info function assumed-type name) nil))
 	   (setf (info function where-from name) :defined))
-	  (:declared); Just keep declared type.
+	  (:declared
+	   (let ((type (info function type name)))
+	     (when (and type (function-type-p dtype))
+	       (let ((type-returns (function-type-returns type))
+		     (dtype-returns (function-type-returns dtype))
+		     (*error-function* #'compiler-warning))
+		 (unless (values-types-intersect type-returns dtype-returns)
+		   (note-lossage "The result type from previous declaration:~%  ~S~@
+				  conflicts with the result type:~%  ~S"
+				 (type-specifier type-returns)
+				 (type-specifier dtype-returns)))))))
 	  (:defined
 	   (when global-p
 	     (setf (info function type name) dtype)))))))
-- 
GitLab