fixed a bug in same-mtime?, all-same-mtime? (behaviour)
fixed a bug in same-perms, wrong port, out -> in added head, tail
This commit is contained in:
parent
93609c80fd
commit
0257dc23a1
|
@ -9,9 +9,8 @@
|
||||||
(let for-each-prereq ((prereq (car prereqs))
|
(let for-each-prereq ((prereq (car prereqs))
|
||||||
(todo (cdr prereqs)))
|
(todo (cdr prereqs)))
|
||||||
(cond
|
(cond
|
||||||
((file-not-exists? prereq)
|
((and (file-exists? prereq)
|
||||||
(error "nonexistent prerequisite" prereq))
|
(> (file-last-mod prereq) target-mtime)) #t)
|
||||||
((> (file-last-mod prereq) target-mtime) #t)
|
|
||||||
((null? todo) #f)
|
((null? todo) #f)
|
||||||
(else (for-each-prereq (car todo) (cdr todo)))))))))
|
(else (for-each-prereq (car todo) (cdr todo)))))))))
|
||||||
|
|
||||||
|
@ -24,11 +23,10 @@
|
||||||
(let for-each-prereq ((prereq (car prereqs))
|
(let for-each-prereq ((prereq (car prereqs))
|
||||||
(todo (cdr prereqs)))
|
(todo (cdr prereqs)))
|
||||||
(cond
|
(cond
|
||||||
((file-not-exists? prereq)
|
((and (file-exists? prereq) (null? todo))
|
||||||
(error "nonexistent prerequisite" prereq))
|
(> (file-last-mod prereq) target-mtime))
|
||||||
((and (null? todo)
|
(else (and (and (file-exists? prereq)
|
||||||
(> (file-last-mod prereq) target-mtime)) #t)
|
(> (file-last-mod prereq) target-mtime))
|
||||||
(else (and (> (file-last-mod prereq) target-mtime)
|
|
||||||
(for-each-prereq (car todo) (cdr todo))))))))))
|
(for-each-prereq (car todo) (cdr todo))))))))))
|
||||||
|
|
||||||
(define (same-perms? target prereqs)
|
(define (same-perms? target prereqs)
|
||||||
|
@ -45,8 +43,8 @@
|
||||||
(let* ((bname (string-append basename extension))
|
(let* ((bname (string-append basename extension))
|
||||||
(file (expand-file-name bname (cwd))))
|
(file (expand-file-name bname (cwd))))
|
||||||
(if (file-exists? file)
|
(if (file-exists? file)
|
||||||
(let* ((outport (open-input-file file))
|
(let* ((inport (open-input-file file))
|
||||||
(strls (port->string-list outport)))
|
(strls (port->string-list inport)))
|
||||||
;; (display ";;; using : ") (display bname) (newline)
|
;; (display ";;; using : ") (display bname) (newline)
|
||||||
(if (null? strls)
|
(if (null? strls)
|
||||||
#f
|
#f
|
||||||
|
@ -83,20 +81,21 @@
|
||||||
(+ current-file-sum previous-total)
|
(+ current-file-sum previous-total)
|
||||||
previous-total)))
|
previous-total)))
|
||||||
(cond
|
(cond
|
||||||
((and (not (null? todo-prereqs)))
|
((not (null? todo-prereqs))
|
||||||
(for-each-prereq (car todo-prereqs)
|
(for-each-prereq (car todo-prereqs)
|
||||||
current-total
|
current-total
|
||||||
(cdr todo-prereqs)))
|
(cdr todo-prereqs)))
|
||||||
((and (null? todo-prereqs) (not (null? extensions)))
|
((not (null? extensions))
|
||||||
(let for-each-ext ((ext (car extensions))
|
(let for-each-ext ((ext (car extensions))
|
||||||
(todo-exts (cdr extensions)))
|
(todo-exts (cdr extensions)))
|
||||||
(let ((known-sum (checksum-from-file target ext)))
|
(let ((known-sum (checksum-from-file target ext))
|
||||||
|
(target-name (string-append target ext)))
|
||||||
(cond
|
(cond
|
||||||
((and (file-not-exists? target) known-sum)
|
((and (file-not-exists? target-name) known-sum)
|
||||||
(begin
|
(begin
|
||||||
(checksum-into-file target ext current-total)
|
(checksum-into-file target ext current-total)
|
||||||
#f))
|
#f))
|
||||||
((and (file-not-exists? target) (null? todo-exts))
|
((and (file-not-exists? target-name) (null? todo-exts))
|
||||||
(begin
|
(begin
|
||||||
(checksum-into-file target
|
(checksum-into-file target
|
||||||
(last (reverse extensions))
|
(last (reverse extensions))
|
||||||
|
@ -116,6 +115,32 @@
|
||||||
(else (error "no match in same-checksum?"))))))
|
(else (error "no match in same-checksum?"))))))
|
||||||
(else (error "no match in same-checksum?")))))))
|
(else (error "no match in same-checksum?")))))))
|
||||||
|
|
||||||
|
(define (head target prereqs)
|
||||||
|
(if (file-not-exists? target)
|
||||||
|
#t
|
||||||
|
(if (null? prereqs)
|
||||||
|
#f
|
||||||
|
(let ((prereq (car prereqs)))
|
||||||
|
(if (file-not-exists? prereq)
|
||||||
|
(error "nonexistent prerequisite" prereq)
|
||||||
|
(> (file-last-mod prereq) (file-last-mod target)))))))
|
||||||
|
|
||||||
|
(define (tail target prereqs)
|
||||||
|
(if (file-not-exists? target)
|
||||||
|
#t
|
||||||
|
(if (null? prereqs)
|
||||||
|
#f
|
||||||
|
(if (null? (cdr prereqs))
|
||||||
|
#f
|
||||||
|
(let ((target-mtime (file-last-mod target)))
|
||||||
|
(let for-each-prereq ((prereq (cadr prereqs))
|
||||||
|
(todo (cddr prereqs)))
|
||||||
|
(cond
|
||||||
|
((and (file-exists? prereq)
|
||||||
|
(> (file-last-mod prereq) target-mtime)) #t)
|
||||||
|
((null? todo) #f)
|
||||||
|
(else (for-each-prereq (car todo) (cdr todo))))))))))
|
||||||
|
|
||||||
(define (always target prereqs) #t)
|
(define (always target prereqs) #t)
|
||||||
|
|
||||||
(define (once target prereqs)
|
(define (once target prereqs)
|
||||||
|
@ -134,9 +159,11 @@
|
||||||
(not (same-perms? target prereqs)))
|
(not (same-perms? target prereqs)))
|
||||||
|
|
||||||
(define (md5-perms target prereqs)
|
(define (md5-perms target prereqs)
|
||||||
(and (not (same-checksum? target digest-extensions prereqs))
|
(or (not (same-perms? target prereqs))
|
||||||
(not (same-perms? target prereqs))
|
(not (same-checksum? target digest-extensions prereqs))))
|
||||||
(not (same-mtime? target prereqs))))
|
|
||||||
|
|
||||||
(define (paranoid target prereqs)
|
(define (paranoid target prereqs)
|
||||||
(not (same-checksum? target digest-extensions prereqs)))
|
(or (not (same-perms? target prereqs))
|
||||||
|
(same-mtime? target prereqs)
|
||||||
|
(not (same-checksum? target digest-extensions prereqs))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue