Add some tests. Fix licensing.HEADmaster

2 files changed, 91 insertions, 1 deletions

diff --git a/tests/backup-tests.lisp b/tests/backup-tests.lisp
new file mode 100644
index 0000000..932ab24
--- /dev/null
+++ b/tests/backup-tests.lisp
@@ -0,0 +1,90 @@
+;; This file is part of ybackup.
+;; Copyright (C) 2023 Piotr Szarmański
+
+;; ybackup 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.
+
+;; ybackup 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 along with
+;; ybackup. If not, see <https://www.gnu.org/licenses/>.
+
+
+(in-package :ybackup/test)
+
+(def-suite* backup-tests :in ybackup-tests )
+
+(defun make-temporary-dir ()
+  (let* ((tmpdir (uiop:temporary-directory))
+         (tmp-tmpdir (make-pathname :directory (serapeum:append1
+                                     (pathname-directory tmpdir)
+                                     (ironclad:byte-array-to-hex-string (ironclad:random-data 10)))
+                         :defaults tmpdir)))
+    (ensure-directories-exist tmp-tmpdir)
+    tmp-tmpdir))
+
+(defun sha256sum (f)
+  (crypto:digest-file :sha256 f))
+
+(defun dir256sum (directory)
+  "Recursively compute sha256 of a directory."
+  (macrolet ((catsum (s)
+               `(crypto:digest-sequence
+                 :sha256
+                 (apply #'concatenate '(simple-array (unsigned-byte 8) (*)) ,s))))
+    (catsum
+     (list
+      (catsum (map 'list #'dir256sum (uiop:subdirectories directory)))
+      (catsum (map 'list #'sha256sum (uiop:directory-files directory)))))))
+
+(defun random-dir (dir)
+  (let ((d (make-pathname
+              :directory
+              (serapeum:append1
+               (pathname-directory dir)
+               (funcall (gen-string :length (gen-integer :min 1 :max 20)
+                                    :elements (gen-character :alphanumericp t)))))))
+    (ensure-directories-exist d)
+    d))
+
+(defun make-random-file (directory)
+  (with-open-file (file (make-pathname
+                         :name (funcall (gen-string :length (gen-integer :min 1 :max 20)
+                                                    :elements (gen-character :alphanumericp t)))
+                         :defaults directory)
+                        :direction :output :if-does-not-exist :create
+                        :element-type 'serapeum:octet)
+    (write-sequence (funcall (gen-buffer :length (gen-integer :min 0 :max 80000))) file)))
+
+(defun random-files (tmpdir)
+  "Make some random files."
+  (lambda ()
+    (flet ((random-files (dir)
+             (loop repeat (random 20) do (make-random-file dir))))
+      (let ((tdir (random-dir tmpdir)))
+       (random-files (random-dir tdir))
+       (random-files (random-dir (random-dir (random-dir tdir))))
+        tdir))))
+
+(test simple-rw-test
+  (let ((tmpdir (make-temporary-dir)))
+    (unwind-protect
+         (for-all ((dir (random-files tmpdir)))
+           (let ((c1 (dir256sum dir))
+                 (backend (make-instance 'eris:hash-backend)))
+             (let* ((urn (make-backup dir backend))
+                    (d1 (random-dir dir)))
+               (read-backup urn backend d1)
+               (is (equalp
+                    c1
+                    (dir256sum
+                     (make-pathname
+                      :directory
+                      (append (pathname-directory d1) (last (pathname-directory dir))))))))))
+      (uiop:delete-directory-tree tmpdir :validate t))))
+
+
diff --git a/tests/package.lisp b/tests/package.lisp
index 8183edf..0755d7c 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -1,5 +1,5 @@
 (defpackage :ybackup/test
-  (:use common-lisp fiveam))
+  (:use #:common-lisp #:fiveam #:ybackup))
 
 (in-package :ybackup/test)
 (def-suite ybackup-tests