(in-package #:montezuma)

(defun do-test-basic-file-ops (dir)
  (atest basic-file-ops (file-count dir) 0)
  (atest basic-file-ops (file-exists-p dir "filename") NIL)
  (touch dir "tmpfile1")
  (atest basic-file-ops (file-count dir) 1)
  (touch dir "tmpfile2")
  (atest basic-file-ops (file-count dir) 2)
  (atest basic-file-ops (and (file-exists-p dir "tmpfile1") T) T)
  (delete-file dir "tmpfile1")
  (atest basic-file-ops (file-exists-p dir "tmpfile1") NIL)
  (atest basic-file-ops (file-count dir) 1))

(defun do-test-rename (dir)
  (touch dir "from")
  (atest rename (and (file-exists-p dir "from") T) T)
  (atest rename (file-exists-p dir "to") NIL)
  (let ((count-before (file-count dir)))
    (rename-file dir "from" "to")
    (let ((count-after (file-count dir)))
      (atest rename count-before count-after)
      (atest rename (and (file-exists-p dir "to") T) T)
      (atest rename (file-exists-p dir "from") NIL))))

(defun do-test-modified (dir)
  (let ((time (get-universal-time)))
    (touch dir "mtime.test")
    (let ((time-before (modified-time dir "mtime.test")))
      (atest modified-time (< (- time-before time) 3) T))))

(defun do-test-rw-bytes (dir)
  (let ((bytes (vector #x34 #x87 #xf9 #xea #x00 #xff)))
    (do-rw-test dir bytes "byte" #'write-byte #'read-byte 6)))

(defun do-test-rw-ints (dir)
  (let ((ints (vector -2147483648 2147483647 -1 0)))
    (do-rw-test dir ints "int" #'write-int #'read-int 16)))

(defun do-test-rw-longs (dir)
  (let ((longs (vector -9223372036854775808 9223372036854775807 -1 0)))
    (do-rw-test dir longs "long" #'write-long #'read-long 32)))

(defun do-test-rw-uints (dir)
  (let ((uints (vector #xffffffff 100000 0)))
    (do-rw-test dir uints "uint" #'write-uint #'read-uint 12)))

(defun do-test-rw-ulongs (dir)
  (let ((ulongs (vector #xffffffffffffffff 100000000000000 0)))
    (do-rw-test dir ulongs "ulong" #'write-ulong #'read-ulong 24)))

(defun do-test-rw-vints (dir)
  (let ((vints (vector 9223372036854775807 #x00 #xFFFFFFFFFFFFFFFF)))
    (do-rw-test dir vints "vint" #'write-vint #'read-vint 20)))

(defun do-test-rw-vlongs (dir)
  (let ((vlongs (vector 9223372036854775807 #x00 #xFFFFFFFFFFFFFFFF)))
    (do-rw-test dir vlongs "vlong" #'write-vlong #'read-vlong 20)))

(defun do-test-rw-strings (dir)
  (flet ((string* (str n)
	   (with-output-to-string (s)
	     (dotimes (i n) (format s "~A" str)))))
    (let ((text "This is a lisp montezuma test string ~!@#$%^&*()`123456790-=\)_+|"))
      (let ((ostream (create-output dir "rw_strings.test")))
	(write-string ostream text)
	(write-string ostream (string* text 100))
	(close ostream))
      (let ((istream (open-input dir "rw_strings.test")))
	(atest rw-strings (read-string istream) text #'string=)
	(atest rw-strings (read-string istream) (string* text 100) #'string=)
	(close istream))
      (atest rw-strings (file-size dir "rw_strings.test") 6467))))

(defun do-test-buffer-seek (dir)
  (let ((ostream (create-output dir "rw_seek.test"))
	(text "This is another long test string !@#$%#$%&%$*%^&*()(_"))
    (dotimes (i 1000)
      (write-long ostream i)
      (write-string ostream text))
    (seek ostream 987)
    (atest buffer-seek (pos ostream) 987)
    (write-vint ostream 555)
    (seek ostream 56)
    (atest buffer-seek (pos ostream) 56)
    (write-vint ostream 1234567890)
    (seek ostream 4000)
    (atest buffer-seek (pos ostream) 4000)
    (write-vint ostream 9876543210)
    (close ostream)
    (let ((istream (open-input dir "rw_seek.test")))
      (seek istream 56)
      (atest buffer-seek (pos istream) 56)
      (atest buffer-seek (read-vint istream) 1234567890)
      (seek istream 4000)
      (atest buffer-seek (pos istream) 4000)
      (atest buffer-seek (read-vint istream) 9876543210)
      (seek istream 987)
      (atest buffer-seek (pos istream) 987)
      (atest buffer-seek (read-vint istream) 555)
      (close istream))))

(defun do-test-read-bytes (dir)
  (let ((str (string-to-bytes "0000000000"))
	(ostream (create-output dir "rw_read_bytes")))
    (write-bytes ostream (string-to-bytes "how are you doing?") 18)
    (close ostream)
    (let ((istream (open-input dir "rw_read_bytes")))
      (read-bytes istream str 2 4)
      (atest read-bytes str (string-to-bytes "00how 0000") #'equalp)
      (read-bytes istream str 1 8)
      (atest read-bytes str (string-to-bytes "0are you 0") #'equalp)
      (close istream))))

(defun do-test-clone (dir)
  (let ((ostream (create-output dir "clone_test")))
    (dotimes (i 10)
      (write-long ostream i))
    (close ostream))
  (let ((istream (open-input dir "clone_test")))
    (seek istream 24)
    (let ((alt-istream (clone istream)))
      (atest clone (pos alt-istream) (pos istream))
      (dotimes (i 7)
	(atest clone (read-long alt-istream) (+ i 3)))
      (atest clone (pos alt-istream) 80)
      (atest clone (pos istream) 24)
      (close alt-istream))
    (dotimes (i 7)
      (atest clone (read-long istream) (+ i 3)))
    (close istream)))


    
(defun do-rw-test (dir values type write-function read-function expected-length)
  (let ((filename (format nil "rw_~A.test" type)))
  (let ((ostream (create-output dir filename)))
    (dotimes (i (length values))
      (funcall write-function ostream (elt values i)))
    (close ostream))
  (let ((istream (open-input dir filename)))
    (dotimes (i (length values))
      (let ((b (funcall read-function istream)))
	(atest rw-test b (elt values i) #'eql
	       (format T "Bad read of type ~S" type))))
    (close istream))
  (atest rw-test (file-size dir filename) expected-length)))
