;;; -*- Lisp -*-

(setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
(chdir *test-directory*)
;;(setf *defaut-pathname-defaults* *test-directory*)

(clear-system 'test-asdf/force)
(assert (not (component-loaded-p 'test-asdf/force)))

(defun force-plan (&rest forcing-options)
  (asdf::make-plan nil 'load-op 'test-asdf/force
                   :forcing (apply 'asdf::make-forcing :system 'test-asdf/force forcing-options)))

(defvar *plan* nil)

(defun component-out-of-date-p (component)
  (not
   (asdf::action-up-to-date-p
    *plan*
    (make-operation 'load-op)
    (find-component component nil :registered t))))

(defun plan-loads-p (component)
  (member (asdf::make-action (make-operation 'load-op) (find-component () component :registered t))
          (asdf::plan-actions *plan*) :test 'equal))

(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force))
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
(assert-equal (asymval :*file4* :test-package) t)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 1)

(defparameter file1 (test-fasl "file1"))
(defparameter file1-date (file-write-date file1))
(defparameter date1 (- file1-date 600))
(defparameter date2 (- file1-date 300))
(assert file1)
(assert file1-date)

(reset-session-visited)
(defparameter *plan* (force-plan :force t))
(DBG "Check that :force t forces the current system but not its dependencies" *plan*)
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (not (component-out-of-date-p '("file3-only" "file3"))))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))

(reset-session-visited)
(defparameter *plan* (force-plan :force :all))
(DBG "Check that :force :all forces the current system and its dependencies" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (component-out-of-date-p '("file3-only" "file3")))
(assert (component-out-of-date-p '("test-asdf/force1" "file1")))

(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not t))
(DBG "Check that :force-not takes precedence over :force, with t means \"all but current system\"" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (not (component-out-of-date-p '("file3-only" "file3"))))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))

(reset-session-visited)
(defparameter *plan* (force-plan :force-not :all))
(DBG "Check that :force-not :all means \"all systems\"" *plan*)
(assert (null (asdf::plan-actions *plan*)))

(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not :all))
(DBG "Check that :force-not :all takes precedence over :force" *plan*)
(assert (null (asdf::plan-actions *plan*)))

(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force)))
(DBG "Check that :force-not with a list takes precedence over :force" *plan*)
(assert (null (asdf::plan-actions *plan*)))

(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force1)))
(DBG "Check that :force-not with a list takes precedence over :force, 2" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
;; transitively included via test-asdf/force1 test-asdf/only, which blocks the traversal
(assert (not (plan-loads-p '("file3-only" "file3"))))
(assert (component-out-of-date-p '("file3-only" "file3")))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))

(reset-session-visited)
(let* ((asdf::*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
       (*plan* (force-plan :force :all)))
  (DBG "Check that immutable-systems will block forcing" *plan*)
  (assert (asdf::plan-actions *plan*))
  (assert (component-out-of-date-p '("test-asdf/force" "file4")))
  ;; transitively included via force1 test-asdf/only, which blocks the traversal
  (assert (not (plan-loads-p '("file3-only" "file3"))))
  (assert (component-out-of-date-p '("file3-only" "file3")))
  (assert (not (component-out-of-date-p '("test-asdf/force1" "file1")))))

;; unforced, date should stay same
(touch-file "test-asdf.asd" :timestamp date1)
(touch-file "file1.lisp" :timestamp date1)
(touch-file file1 :timestamp date2)
(setf test-package::*file1* :modified)
(DBG "Check the fake dates from touch-file")
(assert-equal (get-file-stamp "test-asdf.asd") date1)
(assert-equal (get-file-stamp "file1.lisp") date1)
(assert-equal (get-file-stamp file1) date2)


(DBG "Check that require-system won't reload")
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force1))
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* :modified)

;;; So far, only loaded things once
(assert-equal test-asdf-system::*times-loaded* 1)

(DBG "Check that load-system will reload")
(reset-session-visited)
(setf test-package::*file1* nil)
(setf test-asdf-system::*times-loaded* 10)
(assert (not test-package::*file1*))
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force1))
(assert test-package::*file1*)
;;; This caused a second loading
;; NB: Somehow this is only 1 when using asdf-tools??? WTF?
;; running from asdf with test/ in paths vs running from test/ with no path prefix.
;;(assert-equal (asymval :*times-loaded* :test-asdf-system) 11)
;;TODO: understand what's going on above!


;; forced, it should be later
(DBG "Check that force reloading loads again")
(setf test-asdf-system::*times-loaded* 20)
(reset-session-visited)
(setf test-package::*file3* :reset)
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force :force :all))
(assert-compare (>= (- (get-file-stamp file1) file1-date) 0))
(assert-equal test-package::*file3* t)
(DBG "Check that test-asdf.asd was loaded each time it was forced")
(assert-equal test-asdf-system::*times-loaded* 21)
(DBG "Check that file3-only.asd was loaded only twice, with the :force :all")
(assert-equal asdf-user::*file3-only-asd-loaded* 2)


(DBG "Check that require-system called with touched .asd won't reload the asdf.")
(setf test-asdf-system::*times-loaded* 30)
(setf test-package::*file3* :reset)
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (unset-asdf-cache-entry '(find-system "test-asdf"))
  (unset-asdf-cache-entry '(find-system "test-asdf/force"))
  (touch-file "test-asdf.asd" :timestamp (+ 10000 (get-file-stamp file1)))
  (require-system 'test-asdf/force))
(assert-equal test-asdf-system::*times-loaded* 30)
(assert-equal test-package::*file3* :reset)

(DBG "Check that require-system called with untouched .asd won't reload the asdf.")
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force))
;; Somehow, it loads the system...
(assert-equal test-asdf-system::*times-loaded* 30)
(assert-equal test-package::*file3* :reset)
