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:
jottbee 2005-04-11 19:45:25 +00:00
parent 93609c80fd
commit 0257dc23a1
1 changed files with 48 additions and 21 deletions

View File

@ -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))))