From f861f6da7b4cb1e3321e87170d2a64cb75ff0f2d Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Fri, 22 Oct 2004 18:17:10 +0000
Subject: [PATCH] Change RESULT-TYPE-OR-LOSE to signal an error if the sequence
 type is too hairy for use to handle.  This is a workaround for the ansi-test
 MAP.48:

    (map '(or (vector t 10) (vector t 5)) #'identity '(1 2 3 4 5))

This used to cause an infinite loop.  Now we get an error.

Need to work on this.
---
 code/seq.lisp | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/code/seq.lisp b/code/seq.lisp
index 6e3574ed9..a8e3f36a0 100644
--- a/code/seq.lisp
+++ b/code/seq.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/code/seq.lisp,v 1.49 2004/09/27 21:17:23 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.50 2004/10/22 18:17:10 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -65,8 +65,8 @@
 ;;;    Given an arbitrary type specifier, return a sane sequence type specifier
 ;;; that we can directly match.
 ;;;
-(defun result-type-or-lose (type &optional nil-ok)
-  (let ((type (specifier-type type)))
+(defun result-type-or-lose (seq-type &optional nil-ok)
+  (let ((type (specifier-type seq-type)))
     (cond
       ((eq type *empty-type*)
        (if nil-ok
@@ -77,6 +77,12 @@
 		  :format-control
 		  "NIL output type invalid for this sequence function."
 		  :format-arguments ())))
+      ((or (union-type-p type) (member-type-p type))
+       (error 'simple-type-error
+	      :datum type
+	      :exptected-type 'sequence
+	      :format-control "~S is too hairy for sequence functions."
+	      :format-arguments (list seq-type)))
       ((dolist (seq-type '(list string simple-vector bit-vector))
 	 (when (csubtypep type (specifier-type seq-type))
 	   (return seq-type))))
@@ -88,7 +94,7 @@
 	      :expected-type 'sequence
 	      :format-control
 	      "~S is a bad type specifier for sequence functions."
-	      :format-arguments (list type))))))
+	      :format-arguments (list seq-type))))))
 
 (define-condition index-too-large-error (type-error)
   ()
-- 
GitLab