Fix MAP.ERROR.11 (#1628)

clasp-developers · Sep 6, 2024 · bfaa65e · bfaa65e
2 parents 5fe99b9 + a07daeb
commit bfaa65e
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 13 deletions.
diff --git a/src/lisp/kernel/cmp/opt/opt-sequence.lisp b/src/lisp/kernel/cmp/opt/opt-sequence.lisp
@@ -167,13 +167,22 @@
                      ;; types we kind of just give up.
                      ;; MAKE-SEQUENCE handles any length check.
                      ;; TODO: Call SEQUENCE:MAP for user sequence types, maybe.
-                     (let ((ssyms (gensym-list sequences "SEQUENCE")))
+                     (let* ((ssyms (gensym-list sequences "SEQUENCE"))
+                            (result (gensym "RESULT"))
+                            (result-form `(core::map-into-sequence
+                                           (make-sequence ',type
+                                                          (min ,@(loop for ssym in ssyms
+                                                                       collect `(length ,ssym))))
+                                           ,function ,@ssyms)))
                        `(let (,@(mapcar #'list ssyms sequences))
-                          (core::map-into-sequence
-                           (make-sequence ',type
-                                          (min ,@(loop for ssym in ssyms
-                                                       collect `(length ,ssym))))
-                           ,function ,@ssyms))))))))
+                          ,(if (consp type)
+                               `(let ((,result ,result-form))
+                                  (if (typep ,result ',type)
+                                      ,result
+                                      (error 'type-error
+                                             :datum ,result
+                                             :expected-type ',type)))
+                               result-form))))))))
       form))
 
 ;;;

diff --git a/src/lisp/kernel/lsp/seq.lisp b/src/lisp/kernel/lsp/seq.lisp
@@ -435,12 +435,19 @@ SEQUENCEs, where K is the minimum length of the given SEQUENCEs."
                       (error-sequence-length result result-type l))))
                 result)
               ;; ditto note in CONCATENATE above
-              (let ((length
-                      (reduce #'min more-sequences
-                              :initial-value (length sequence)
-                              :key #'length)))
-                (apply #'map-into (make-sequence result-type length)
-                       function sequence more-sequences))))
+              (let ((result
+                      (apply #'map-into
+                             (make-sequence result-type
+                                            (reduce #'min more-sequences
+                                                    :initial-value (length sequence)
+                                                    :key #'length))
+                             function sequence more-sequences)))
+                (if (or (not (consp result-type))
+                        (typep result result-type))
+                    result
+                    (error 'type-error
+                           :datum result
+                           :expected-type result-type)))))
         (apply #'map-for-effect function sequence more-sequences))))
 
 (defun map-to-list (function &rest sequences)

diff --git a/tools-for-build/ansi-test-expected-failures.sexp b/tools-for-build/ansi-test-expected-failures.sexp
@@ -43,7 +43,6 @@ CALL-NEXT-METHOD.ERROR.2
 DEFMETHOD.ERROR.14
 DEFMETHOD.ERROR.15
 UPGRADED-ARRAY-ELEMENT-TYPE.8
-MAP.ERROR.11
 TYPE-OF.1
 TYPE-OF.4
 COMPILE-FILE.2