From b7bdbc4d0db836b56a588d83c5da1f3ef6e42f3e Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Wed, 9 Mar 2016 12:47:05 +0100 Subject: [PATCH] Fix result sequence creation in SEQUENCE:MAP It passed (class-of result-prototype) to MAKE-SEQUENCE which, in the best case, would go back to the prototype of the class and call SEQUENCE:MAKE-SEQUENCE-LIKE on it. All subtype queries and whatnot performed by MAKE-SEQUENCE before finally calling SEQUENCE:MAKE-SEQUENCE-LIKE are unnecessary in the common case of SEQUENCE:MAP being called from MAP in which case the result type is an extended sequence. Instead, directly call SEQUENCE:MAKE-SEQUENCE-LIKE on RESULT-PROTOTYPE. This is what SEQUENCE:{CONCATENATE,MERGE} already do. --- src/pcl/sequence.lisp | 4 ++-- tests/extended-sequences.impure.lisp | 3 +++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/pcl/sequence.lisp b/src/pcl/sequence.lisp index aba2f90d0..7cc2c12e7 100644 --- a/src/pcl/sequence.lisp +++ b/src/pcl/sequence.lisp @@ -435,10 +435,10 @@ (%map-for-effect #'counting-visit sequences)) ;; Map local function over SEQUENCES that steps through the result ;; sequence and stores results of applying FUNCTION. - (binding* ((result (make-sequence (class-of result-prototype) min-length)) + (binding* ((result (sequence:make-sequence-like result-prototype min-length)) ((state nil from-end step nil nil setelt) (sequence:make-sequence-iterator result))) - (declare (type function state step setelt)) + (declare (type function step setelt)) (flet ((one-element (&rest args) (declare (truly-dynamic-extent args)) (funcall setelt (apply function args) result state) diff --git a/tests/extended-sequences.impure.lisp b/tests/extended-sequences.impure.lisp index 73205ea5e..992425295 100644 --- a/tests/extended-sequences.impure.lisp +++ b/tests/extended-sequences.impure.lisp @@ -48,3 +48,6 @@ (with-test (:name (make-sequence :type-specifier class)) (make-sequence (find-class 'extended-sequence) 3)) + +(with-test (:name (map make-sequence :result-creation)) + (assert (typep (map 'extended-sequence #'1+ '(1 2 3)) 'extended-sequence))) -- 2.11.4.GIT