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