Commit 06a3725d authored by Jan Moringen's avatar Jan Moringen Committed by Attila Lendvai

fix STARTS-WITH-SUBSEQ for non-array sequences

parent 926a0666
......@@ -300,28 +300,40 @@ sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
"Test whether the first elements of SEQUENCE are the same (as per TEST) as the elements of PREFIX.
If RETURN-SUFFIX is T the function returns, as a second value, a
displaced array pointing to the sequence after PREFIX."
sub-sequence or displaced array pointing to the sequence after PREFIX."
(declare (dynamic-extent args))
(let ((sequence-length (length sequence))
(prefix-length (length prefix)))
(if (<= prefix-length sequence-length)
(let ((mismatch (apply #'mismatch prefix sequence
(if return-suffix-supplied-p
(remove-from-plist args :return-suffix)
args))))
(if mismatch
(if (< mismatch prefix-length)
(values nil nil)
(values t (when return-suffix
(make-array (- sequence-length mismatch)
:element-type (array-element-type sequence)
:displaced-to sequence
:displaced-index-offset prefix-length
:adjustable nil))))
(values t (when return-suffix
(make-array 0 :element-type (array-element-type sequence)
:adjustable nil)))))
(values nil nil))))
(when (< sequence-length prefix-length)
(return-from starts-with-subseq (values nil nil)))
(flet ((make-suffix (start)
(when return-suffix
(cond
((not (arrayp sequence))
(if start
(subseq sequence start)
(subseq sequence 0 0)))
((not start)
(make-array 0
:element-type (array-element-type sequence)
:adjustable nil))
(t
(make-array (- sequence-length start)
:element-type (array-element-type sequence)
:displaced-to sequence
:displaced-index-offset start
:adjustable nil))))))
(let ((mismatch (apply #'mismatch prefix sequence
(if return-suffix-supplied-p
(remove-from-plist args :return-suffix)
args))))
(cond
((not mismatch)
(values t (make-suffix nil)))
((= mismatch prefix-length)
(values t (make-suffix mismatch)))
(t
(values nil nil)))))))
(defun ends-with-subseq (suffix sequence &key (test #'eql))
"Test whether SEQUENCE ends with SUFFIX. In other words: return true if
......
......@@ -1960,6 +1960,21 @@
n)
13)
(deftest starts-with-subseq.string
(starts-with-subseq "f" "foo" :return-suffix t)
t
"oo")
(deftest starts-with-subseq.vector
(starts-with-subseq #(1) #(1 2 3) :return-suffix t)
t
#(2 3))
(deftest starts-with-subseq.list
(starts-with-subseq '(1) '(1 2 3) :return-suffix t)
t
(2 3))
(deftest starts-with-subseq.start1
(starts-with-subseq "foo" "oop" :start1 1)
t
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment