sublistp with test function

by Вася Пупкинъ on March 10th, 2010

sublistp-1 tests whether second argument is a sublist of the first argument
test-sublistp-1 provides some unit testing

Syntax: Lisp
Show lines - Hide lines - Show in textbox - Download
(defun sublistp-1 (list sub-list &key (test 'eql))
  ;; Basic null tests
  (when (and (null list)
             (null sub-list))
    (return-from sublistp-1 t))
  (when (xor (null list)
             (null sub-list))
    (return-from sublistp-1 nil))
  ;; Recursive part
  (dolist (list-el list)
    (block secondary-comparison
      (dolist (sub-list-el sub-list)
        (when (funcall test
                       list-el
                       sub-list-el)
          (return-from sublistp-1
            (if (null (cdr sub-list))
                t
                (sublistp-1 (cdr list)
                            (cdr sub-list)))))
        (return-from secondary-comparison))))
  nil)
 
 
 
;; Unit test
(defun test-sublistp-1 ()
  (let ((tests (list
                '(nil nil t)
                '(nil (1) nil)
                '((1) nil nil)
                '((1 2 3) (1 2 3) t)
                '((1 2 3) (1 2 3 4) nil)
                '((1 2 3) (1 2) t)))
        (all-tests-passed t))
    (dolist (test-case tests)
      (let ((test-result (funcall #'sublistp-1
                                  (first test-case)
                                  (second test-case)))
            (expected-result (third test-case)))
        (when (not (eql test-result
                        expected-result))
          (format t "Test failed on lists:~a~a~%"
                  (first test-case)
                  (second test-case))
          (setf all-tests-passed nil))))
    all-tests-passed))

Leave a Reply

Note: XHTML is allowed. Your email address will never be published.

Subscribe to this comment feed via RSS