From ccb22e7f0db70fd37eccb32e7f124ef6bd7fa032 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 3 Jan 2018 13:17:31 +0300 Subject: [PATCH] Don't crash when transforming (map values-type ...) Fixes lp#1740975. --- src/compiler/seqtran.lisp | 8 +++++--- tests/bad-code.pure.lisp | 8 ++++++++ 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index aa331a015..c4017410b 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -255,16 +255,18 @@ (give-up-ir1-transform "RESULT-TYPE argument not constant")) (flet ( ;; 1-valued SUBTYPEP, fails unless second value of SUBTYPEP is true (1subtypep (x y) - (multiple-value-bind (subtype-p valid-p) (sb!xc:subtypep x y) + (multiple-value-bind (subtype-p valid-p) + (csubtypep x (specifier-type y)) (if valid-p subtype-p (give-up-ir1-transform "can't analyze sequence type relationship"))))) (let* ((result-type-value (lvar-value result-type)) + (result-type-ctype (specifier-type-or-warn-and-give-up result-type-value)) (result-supertype (cond ((null result-type-value) 'null) - ((1subtypep result-type-value 'vector) + ((1subtypep result-type-ctype 'vector) 'vector) - ((1subtypep result-type-value 'list) + ((1subtypep result-type-ctype 'list) 'list) (t (give-up-ir1-transform diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp index f113ab087..b7bd35822 100644 --- a/tests/bad-code.pure.lisp +++ b/tests/bad-code.pure.lisp @@ -96,3 +96,11 @@ `(lambda () (make-array (list 'x))) :allow-warnings t)))) + +(with-test (:name (map :values-type)) + (assert + (nth-value 1 + (checked-compile + `(lambda () + (map '* #'+ #(1) #(2))) + :allow-warnings t)))) -- 2.11.4.GIT