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