;;; -*- indent-tabs-mode: nil -*-

(defpackage :sb-heapdump-test
  (:use :cl :sb-heapdump :sb-rt))

(in-package :sb-heapdump-test)

(rem-all-tests)

(defun %load-dumpfile (&rest args)
  (multiple-value-prog1
      (apply #'load-dumpfile args)
    (sb-ext:gc :full t)))

(defparameter *test-path*
  (merge-pathnames (make-pathname :name :unspecific :type :unspecific
                                  :version :unspecific)
                   *load-truename*)
  "Directory for temporary test files.")

(defparameter *test-file*
  (merge-pathnames #p"test.heap" *test-path*))

(let ((b sb-heapdump::*default-base-address*))
  (defun make-address ()
    (incf b (* 1 1024 1024))))

(deftest hash-table.1
    (progn
      (dump-object (let ((x (make-hash-table)))
                     (setf (gethash 'foo x) 'bar)
                     x)
                   *test-file*
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (values (gethash 'foo (%load-dumpfile *test-file*))))
  bar)

(deftest code-component.1
    (progn
      (dump-object (lambda ())
                   *test-file*
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (funcall (%load-dumpfile *test-file*)))
  nil)

(defun ff (x) (if (zerop x) 1 (* x (ff (1- x)))))

(deftest code-component.2
    (progn
      (dump-object #'ff
                   *test-file*
                   :force t
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (funcall (%load-dumpfile *test-file*) 3))
  6)

(deftest initializer-is-fixup.1
    (progn
      (dump-object '("foo" "bar")
                   *test-file*
                   :base-address (make-address)
                   :force t
                   :initializer #'print
                   :if-exists :rename-and-delete)
      (%load-dumpfile *test-file*)
      t)
  t)

(deftest weak-pointer.1
    (progn
      (dump-object (list '#1=#:foo (sb-ext:make-weak-pointer '#1#))
                   *test-file*
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (destructuring-bind (thing wp)
          (%load-dumpfile *test-file*)
        (eq thing (sb-ext:weak-pointer-value wp))))
  t)

(deftest weak-pointer.2
    (progn
      (dump-object (list (sb-ext:make-weak-pointer (list 1 2 3)))
                   *test-file*
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (sb-ext:weak-pointer-value (car (%load-dumpfile *test-file*))))
  nil
  nil)

(deftest weak-pointer.3
    (progn
      (dump-object (list (sb-ext:make-weak-pointer :foo))
                   *test-file*
                   :base-address (make-address)
                   :if-exists :rename-and-delete)
      (sb-ext:weak-pointer-value (car (%load-dumpfile *test-file*))))
  :foo
  t)

(deftest package.1
    (progn
      (dump-packages '(:scratch)
                     *test-file*
                   :base-address (make-address)
                     :if-exists :rename-and-delete)
      (delete-package :scratch)
      (%load-dumpfile *test-file*)
      (let ((i (symbol-value (find-symbol "*I*" "SCRATCH"))))
        (and (typep i (find-symbol "SUB" "SCRATCH"))
             (eql (funcall (find-symbol "A" "SCRATCH") i) 1)
             (eql (funcall (find-symbol "B" "SCRATCH") i) 2)
             (eql (funcall (find-symbol "GF" "SCRATCH") i) 2)
             (eql (funcall (find-symbol "FN" "SCRATCH") i) 2))))
  t)