Changeset 15487


Ignore:
Timestamp:
11/30/20 08:22:27 (2 years ago)
Author:
Mark Evenson
Message:

Test for zip-cache contents

TODO: test for more than singly nested zip entries.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/t/pathname.lisp

    r15130 r15487  
    66  (prove:like (namestring p) "^/directory/name.version$"))
    77
     8(defparameter *removable-artifacts* nil)
     9
     10(defun create-zip ()
     11  (uiop:with-temporary-file (:pathname tmp :type "zip" :keep t)
     12    (let* ((file
     13             (create-file))
     14           (fasl
     15             (compile-file file))
     16           (renamed-file
     17             (rename-file file (make-pathname :defaults file :name "output-date")))
     18           (renamed-fasl
     19             (rename-file fasl (make-pathname :defaults fasl :name "output-date")))
     20           (contents
     21             `(,renamed-file ,renamed-fasl))
     22           (zipfile
     23             (sys:zip tmp contents)))
     24      (dolist (file (list renamed-file renamed-fasl zipfile))
     25        (pushnew file *removable-artifacts*))
     26      (values
     27       zipfile
     28       contents))))
     29 
     30(defun create-file ()
     31  (uiop:with-temporary-file (:stream s :pathname p :keep t :type "lisp")
     32    (write
     33     `(format t "~s ~s~%" ,(get-universal-time) (symbol-name (gensym)))
     34     :stream s)
     35    p))
     36
     37(prove:plan 5)
     38(let* ((zip-1
     39         (create-zip))
     40       (zip-2
     41         (progn
     42           (sleep 1.5)
     43           (create-zip)))
     44       (zip-tmp-1
     45         (make-pathname :defaults zip-1 :type "tmp"))
     46       (zip-tmp-2
     47         (make-pathname :defaults zip-2 :type "tmp"))
     48       (zip-1-path
     49         (ext:as-jar-pathname-archive zip-1))
     50       (zip-2-path
     51         (ext:as-jar-pathname-archive zip-2))
     52       (zip-1-entry-1
     53         (merge-pathnames "output-date.lisp" zip-1-path))
     54       (zip-2-entry-1
     55         (merge-pathnames "output-date.lisp" zip-2-path))
     56       (zip-1-entry-2
     57         (merge-pathnames "output-date.abcl" zip-1-path))
     58       (zip-2-entry-2
     59         (merge-pathnames "output-date.abcl" zip-2-path)))
     60
     61  (uiop:copy-file zip-1 zip-tmp-1)
     62  (uiop:copy-file zip-2 zip-tmp-2)
     63
     64  ;;; If the first two tests fail, we have not setup the test correctly
     65  ;;; FIXME: how to bail on the remaining tests early?
     66  (let ((zip-1-date (file-write-date zip-1))
     67        (zip-2-date (file-write-date zip-2)))
     68    (prove:ok
     69     (not (equal zip-1-date zip-2-date))
     70     (format nil "Archives have different times~%~a ~a~%~a ~a~%"
     71             zip-1-date zip-1
     72             zip-2-date zip-2)))
     73  (let ((date-1 (file-write-date zip-1-entry-1))
     74        (date-2 (file-write-date zip-2-entry-1)))
     75    (prove:ok
     76     (not (equal date-1 date-2))
     77     (format nil "Archive entries have different times~%~a <~a>~%~a <~a>~%"
     78             date-1 zip-1-entry-1
     79             date-2 zip-2-entry-1)))
     80 
     81  (let ((date-1 (file-write-date zip-1-path)))
     82    (sleep 1)
     83    (rename-file zip-2 zip-1)
     84    (let ((date-2 (file-write-date zip-1-path)))
     85      (prove:ok
     86       (not (equal date-1 date-2))
     87       (format nil "ZipCache recomputes date on JAR-PATHNAME archive~%<~a>~%~a ~a~%"
     88               zip-1-path date-1 date-2))))
     89
     90  (uiop:copy-file zip-tmp-1 zip-1)
     91  (uiop:copy-file zip-tmp-2 zip-2)
     92  (let ((date-1 (file-write-date zip-1-entry-1)))
     93    (sleep 1.1)
     94    (rename-file zip-2 zip-1)
     95    (let ((date-2 (file-write-date zip-1-entry-1)))
     96      (prove:ok
     97       (not (equal date-1 date-2))
     98       (format nil "ZipCache recomputes JAR-PATHNAME entry dates~%<~a>~%~a ~a~%"
     99               zip-1-entry-1
     100               date-1 date-2))))
     101
     102  (uiop:copy-file zip-tmp-1 zip-1)
     103  (uiop:copy-file zip-tmp-2 zip-2)
     104  (let* ((entry
     105           (make-pathname :defaults (ext:as-jar-pathname-archive zip-1-entry-2)
     106                          :name "__loader__" :type "_"))
     107         (date-1
     108           (file-write-date entry)))
     109    (sleep 1.1)
     110    (rename-file zip-2 zip-1)
     111    (let ((date-2 (file-write-date entry)))
     112      (prove:ok
     113       (not (equal date-1 date-2))
     114       (format nil "ZipCache recomputes singly nested JAR-PATHNAME entry dates~%<~a>~%~a ~a~%"
     115               entry
     116               date-1 date-2)))))
     117
    8118(prove:finalize)
    9119
Note: See TracChangeset for help on using the changeset viewer.