;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :wvu-lib-test.tricks)

;;; list stuff
(defvar *alist* nil "alist used for testing")
(defvar *tlist1* nil "test list 1")
(defvar *tlist2* nil "test list 2")
(deftestsuite list-lib-test-suite (wvu-lib-tests) ()
  :dynamic-variables (*alist*)
  :setup (setf *alist*
               (list
                (cons 'fred "fred")
                (cons 'jane "jane")
                (cons 'ptest (list "eggs" "bacon"))
                (cons 'ptest-empty nil))
               *tlist1* (list 1 2 3)
               *tlist2* (list 4 5 6))
  :teardown (setf *alist* nil
                  *tlist1* nil
                  *tlist2* nil))


(addtest check-as-list-non-list
  (let* ((non-list 'a)
         (l (ensure-no-warning (as-list non-list))))
    (ensure-null (listp non-list)
                 :report "non-list is a list")
    (ensure l
            :report "l is nil")
    (ensure (listp l)
            :report "l is not a list")))

(addtest check-as-list-list
  (let* ((is-list '(a))
         (l (ensure-no-warning (as-list is-list))))
    (ensure (listp is-list)
            :report "is-list is not a list")
    (ensure l
            :report "l is nil")
    (ensure (listp l)
            :report "l is not a list")
    (ensure-same l
                 is-list
                 :test #'equalp
                 :report "l is different from is-list")))

(addtest check-transpose
  (ensure-same (ensure-no-warning (transpose '((1 2 3) (5 6 7))))
               '((1 5) (2 6) (3 7))
               :test #'equalp))

(addtest check-transpose-nil
  (ensure-null (ensure-no-warning (transpose nil))
               :report "transpose nil returned non-nil"))

(addtest check-insert-delim-nil
  (ensure-null (ensure-no-warning (insert-delim nil '-))
               :report "insert-delim with nil returned non-nil"))

(addtest check-insert-delim-singleton
  (ensure-same (ensure-no-warning (insert-delim '(1) '-))
               '(1)
               :test #'equalp))

(addtest check-insert-delim-list
  (ensure-same (ensure-no-warning (insert-delim '(1 2 3) '-))
               '(1 - 2 - 3)
               :test #'equalp))

(addtest check-geta-value
  (let ((key-in-alist 'fred))
    (ensure-alist-has-key key-in-alist *alist*)
    (multiple-value-bind (value foundp)
        (ensure-no-warning (geta key-in-alist *alist*))
      (ensure foundp
              :report "existent key (~a) not found in the association list"
              :arguments (key-in-alist))
      (ensure-same value
                   "fred"))))

(addtest check-geta-non-value-no-default
  (let ((key-not-in-alist 'not-in-alist))
    (ensure-alist-has-no-key key-not-in-alist *alist*)
    (multiple-value-bind (value foundp)
        (ensure-no-warning (geta key-not-in-alist *alist*))
      (ensure-null foundp
                   :report "non-existent key (~a) found in an association list"
                   :arguments (key-not-in-alist))
      (ensure-null value
                   :report "value was non-nil when key wasn't found and no default"))))

(addtest check-geta-non-value-default
  (let ((key-not-in-alist 'not-in-alist)
        (default-value 3))
    (ensure-alist-has-no-key key-not-in-alist *alist*)
    (multiple-value-bind (value foundp)
        (ensure-no-warning (geta key-not-in-alist *alist* default-value))
      (ensure-null foundp
                   :report "non-existent value found in an association list")
      (ensure default-value
              :report "test specified default value is nil")
      (ensure-same value
                   default-value))))

(addtest check-puta-same-alist-insert
  (let ((key 'a)
        (value 1))
    (ensure-alist-has-no-key key *alist*)
    (ensure-same (ensure-no-warning (puta key value *alist*))
                 *alist*
                 :report "alist is different after puta insert")
    (ensure-alist-has-key key *alist*)))

(addtest check-puta-same-alist-update
  (let ((key 'fred)
        (value 9))
    (ensure-alist-has-key key *alist*)
    (ensure-same (puta key value *alist*)
                 *alist*
                 :report "alist is different after puta update")
    (ensure-alist-has-key key *alist*)))

(addtest check-puta-same-alist-empty
  (setf *alist* nil)
  (let ((key 'a)
        (value 1))
    (ensure-same (ensure-no-warning (puta key value *alist*))
                 *alist*
                 :report "alist is different after puta insert with empty alist")
    (ensure-alist-has-key key *alist*)))

(addtest check-puta-insert-empty-alist
  (setf *alist* nil)
  (let ((key 'a)
        (value 1))
    (ensure value
            :report "test value is nil")
    (ensure-alist-has-no-key key *alist*)
    (ensure-no-warning (puta key value *alist*))
    (ensure-alist-has-key key *alist*)
    (multiple-value-bind (got-value foundp)
        (geta key *alist*)
      (ensure foundp
              :report "inserted value not found")
      (ensure-same got-value
                   value))))

(addtest check-puta-insert-non-empty-alist
  (let ((key 'a)
        (value 2))
    (ensure value
            :report "test value is nil")
    (ensure-alist-has-no-key key *alist*)
    (ensure-no-warning (puta key value *alist*))
    (ensure-alist-has-key key *alist*)
    (multiple-value-bind (got-value foundp)
        (geta key *alist*)
      (ensure foundp
              :report "inserted value not found")
      (ensure-same got-value
                   value))))

(addtest check-puta-update
  (let ((key 'fred)
        (value 1))
    (ensure-alist-has-key key *alist*)
    (ensure-no-warning (puta key value *alist*))
    (ensure-same (geta key *alist*)
                 value
                 :report "puta update not the same")))

(addtest check-pusha
  (let ((key 'ptest)
        (test-val "bananas"))
    (ensure-alist-has-key key *alist*)
    (ensure-no-warning (pusha key test-val *alist*))
    (ensure-same (geta key *alist*)
                 (list "bananas" "eggs" "bacon")
                 :test #'equalp)))

(addtest check-pusha-empty
  (let ((key 'ptest-empty)
        (test-val "tval2"))
    (ensure-alist-has-no-key key *alist*)
    (ensure-no-warning (pusha key test-val *alist*))
    (ensure-same (geta key *alist*)
                 (list test-val)
                 :test #'equalp)))

(addtest check-popa
  (let ((key 'ptest)
        (expected-popped-val "eggs"))
    (ensure-alist-has-key key *alist*)
    (let ((popped-value (ensure-no-warning (popa 'ptest *alist*))))
      (ensure-same popped-value
                   expected-popped-val
                   :test #'equalp)
      (ensure-same (geta 'ptest *alist*)
                   (list "bacon")
                   :test #'equalp))))

(addtest check-popa-empty
  (let ((key 'ptest-empty))
    (ensure-alist-has-key key *alist*)
    (ensure-null (geta key *alist*))
    (ensure-null (ensure-no-warning (popa key *alist*)))))

(addtest check-popa-no-key
  (let ((key 'ptest-bad))
    (ensure-alist-has-no-key key *alist*)
    (ensure-null (ensure-no-warning (popa key *alist*)))))

(addtest check-move-elt-item-found
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (item 1))
    (ensure-no-warning (move-elt item *tlist1* *tlist2*))
    (ensure (subsetp *tlist1* org-tlist1 :test #'equalp))
    (ensure (subsetp org-tlist2 *tlist2* :test #'equalp))
    (ensure-null (member item *tlist1*))
    (ensure (member item *tlist2*))))

(addtest check-move-elt-item-not-found
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (item 7))
    (ensure-no-warning (move-elt item *tlist1* *tlist2*))
    (ensure-same *tlist1* org-tlist1 :test #'equalp)
    (ensure-same *tlist2* org-tlist2 :test #'equalp)))

(addtest check-move-elts
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (found-items '(1 2))
         (not-found-items '(7))
         (items (append found-items not-found-items)))
    (ensure-no-warning (move-elts items *tlist1* *tlist2*))
    (ensure (subsetp *tlist1* org-tlist1 :test #'equalp)
            :report "items were added to *tlist1*")
    (ensure (subsetp org-tlist2 *tlist2* :test #'equalp)
            :report "items were removed from *tlist2*")
    (ensure-null (some #'(lambda (x) (member x *tlist1*))
                       found-items)
                 :report "found-items aren't supposed to be in *tlist1*")
    (ensure (every #'(lambda (x) (member x *tlist2*))
                   found-items)
            :report "found-items are supposed to be in *tlist2*")))

(addtest check-switch-elt-first
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (item 1))
    (ensure-no-warning (switch-elt item *tlist1* *tlist2*))
    (ensure (subsetp *tlist1* org-tlist1 :test #'equalp))
    (ensure (subsetp org-tlist2 *tlist2* :test #'equalp))
    (ensure-null (member item *tlist1*))
    (ensure (member item *tlist2*))))

(addtest check-switch-elt-second
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (*tlist1* (copy-list org-tlist1))
         (*tlist2* (copy-list org-tlist2))
         (item 1))
    (ensure-no-warning (switch-elt item *tlist2* *tlist1*))
    (ensure (subsetp *tlist1* org-tlist1 :test #'equalp))
    (ensure (subsetp org-tlist2 *tlist2* :test #'equalp))
    (ensure-null (member item *tlist1*))
    (ensure (member item *tlist2*))))

(addtest check-switch-elts
  (let* ((org-tlist1 (copy-list *tlist1*))
         (org-tlist2 (copy-list *tlist2*))
         (items-from-tlist1 '(1 2))
         (items-from-tlist2 '(5 6))
         (items (append items-from-tlist1 items-from-tlist2)))
    (ensure-no-warning (switch-elts items *tlist1* *tlist2*))
    (ensure-null (some #'(lambda (x) (member x *tlist1*))
                       items-from-tlist1)
                 :report "items-from-tlist1 shouldn't be in *tlist1*")
    (ensure (every #'(lambda (x) (member x *tlist1*))
                                 items-from-tlist2)
            :report "items-from-tlist2 should be in *tlist1*")
    (ensure-null (some #'(lambda (x) (member x *tlist2*))
                       items-from-tlist2)
                 :report "items-from-*tlist2* shouldn't be in *tlist2*")
    (ensure (every #'(lambda (x) (member x *tlist2*))
                                 items-from-tlist1)
            :report "items-from-tlist1 should be in *tlist2*")))

(addtest check-subset-compare-equal
  (ensure (subset-compare '(1 2 3) '(3 2 1))))

(addtest check-subset-compare-subset
  (ensure-null (subset-compare '(1 2) '(3 2 1))))

(addtest check-subset-compare-not-equal
  (ensure-null (subset-compare '(1 2) '(3 2))))

(addtest check-array2matrix-1d
  (let* ((initial-matrix '(1))
         (array (make-array '(1) :initial-contents initial-matrix)))
    (ensure-same (array2matrix array)
                 initial-matrix
                 :test #'equalp)))

(addtest check-array2matrix-2d
  (let* ((initial-matrix '((1 2) (3 4) (4 5)))
         (array (make-array '(3 2) :initial-contents initial-matrix)))
    (ensure-same (array2matrix array)
                 initial-matrix
                 :test #'equalp)))

(addtest check-array2matrix-3d
  (let* ((initial-matrix '(((1 2) (3 4) (4 5))
                           ((3 2) (6 7) (5 0))))
         (array (make-array '(2 3 2) :initial-contents initial-matrix)))
    (ensure-same (array2matrix array)
                 initial-matrix
                 :test #'equalp)))

(addtest check-count-items
  (let* ((seq '(a g b c  x d d e e f a d f b))
         counts)
    (ensure-no-warning (setf counts (count-items seq)))
    (ensure-same (cdr (assoc 'a counts)) 2 :report "a count isn't correct")
    (ensure-same (cdr (assoc 'b counts)) 2 :report "b count isn't correct")
    (ensure-same (cdr (assoc 'c counts)) 1 :report "c count isn't correct")
    (ensure-same (cdr (assoc 'd counts)) 3 :report "d count isn't correct")
    (ensure-same (cdr (assoc 'e counts)) 2 :report "e count isn't correct")
    (ensure-same (cdr (assoc 'f counts)) 2 :report "f count isn't correct")
    (ensure-same (cdr (assoc 'g counts)) 1 :report "g count isn't correct")
    (ensure-same (cdr (assoc 'x counts)) 1 :report "x count isn't correct")))

(addtest check-count-items-test
  (let* ((seq '((a . b) (a . b) (b . a) (c . b) (a . b) (b . b)))
         (test #'equalp)
         counts)
    (ensure-no-warning (setf counts (count-items seq :test test)))
    (ensure-same (cdr (assoc '(a . b) counts :test test)) 3 :report "(a . b) count isn't correct")
    (ensure-same (cdr (assoc '(b . b) counts :test test)) 1 :report "(b . b) count isn't correct")
    (ensure-same (cdr (assoc '(b . a) counts :test test)) 1 :report "(b . a) count isn't correct")
    (ensure-same (cdr (assoc '(c . b) counts :test test)) 1 :report "(c . b) count isn't correct")))

(addtest check-count-items-key-car
  (let* ((seq '((a . b) (a . b) (b . a) (c . b) (a . b) (b . b)))
         counts)
    (ensure-no-warning (setf counts (count-items seq :key #'car)))
    (ensure-same (cdr (assoc '(a . b) counts :test #'equalp)) 3 :report "(a . b) count isn't correct")
    (ensure-same (cdr (assoc '(b . a) counts :test #'equalp)) 2 :report "(b . a) count isn't correct")
    (ensure-same (cdr (assoc '(c . b) counts :test #'equalp)) 1 :report "(c . b) count isn't correct")))

(addtest check-count-items-key-cdr
  (let* ((seq '((a . b) (a . b) (b . a) (c . b) (a . b) (b . b)))
         counts)
    (ensure-no-warning (setf counts (count-items seq :key #'cdr)))
    (ensure-same (cdr (assoc '(a . b) counts :test #'equalp)) 5 :report "(a . b) count isn't correct")
    (ensure-same (cdr (assoc '(b . a) counts :test #'equalp)) 1 :report "(b . a) count isn't correct")))