From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 18 Oct 2007 15:57:40 +0000 (+0000)
Subject: Fix bzr command cache to pay attention to timestamp of workfile.
X-Git-Tag: 20090517-FFI~417
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1e59826d64659fcf40a7469bab2132f150d675f2;p=mit-scheme.git

Fix bzr command cache to pay attention to timestamp of workfile.
---

diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 37801b540..02affcdc5 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vc.scm,v 1.100 2007/10/17 18:50:22 cph Exp $
+$Id: vc.scm,v 1.101 2007/10/18 15:57:40 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -2522,24 +2522,6 @@ the value of vc-log-mode-hook."
 	      ((pair? (cdr path)) (loop (except-last-pair path)))
 	      (else #f))))))
 
-(define (get-bzr-status workfile #!optional required?)
-  (let ((workfile
-	 (if (vc-master? workfile)
-	     (vc-master-workfile workfile)
-	     workfile)))
-    (or (parse-bzr-status (%get-bzr-status workfile))
-	(cond ((bzr-workfile-versioned? workfile)
-	       (make-bzr-status 'VERSIONED 'UNMODIFIED #f))
-	      ((bzr-workfile-ignored? workfile)
-	       (make-bzr-status 'UNVERSIONED 'UNMODIFIED #f))
-	      ((bzr-workfile-unknown? workfile)
-	       (make-bzr-status 'UNKNOWN 'UNMODIFIED #f))
-	      (else
-	       (if (if (default-object? required?) #f required?)
-		   (error "Unable to determine Bazaar status of file:"
-			  workfile))
-	       #f)))))
-
 (define (bzr-workfile-versioned? workfile)
   (%bzr-ls-test workfile "--versioned"))
 
@@ -2556,23 +2538,28 @@ the value of vc-log-mode-hook."
 						  (file-namestring workfile)
 						  "$")
 				   result))))
-
-(define (%get-bzr-status workfile)
-  (%bzr-run-command workfile "status" "--short" (file-namestring workfile)))
 
 (define (%bzr-run-command workfile command . args)
-  (let ((alist (1d-table/get %bzr-command-cache workfile '()))
+  (let ((entry
+	 (hash-table/intern! %bzr-command-cache (->namestring workfile)
+	   (lambda ()
+	     (list -1))))
+	(t (file-modification-time workfile))
 	(key (cons command args)))
-    (let ((p (assoc key alist)))
-      (if p
-	  (cdr p)
-	  (let ((result (%bzr-run-command-1 workfile command args)))
-	    (1d-table/put! %bzr-command-cache
-			   workfile
-			   (cons (cons key result) alist))
-	    result)))))
-
-(define %bzr-command-cache (make-1d-table))
+    (if (= t (car entry))
+	(let ((p (assoc key (cdr entry))))
+	  (if p
+	      (cdr p)
+	      (let ((result (%bzr-run-command-1 workfile command args)))
+		(set-cdr! entry (cons (cons key result) (cdr entry)))
+		result)))
+	(let ((result (%bzr-run-command-1 workfile command args)))
+	  (set-cdr! entry (list (cons key result)))
+	  (set-car! entry t)
+	  result))))
+
+(define %bzr-command-cache
+  (make-string-hash-table))
 
 (define (%bzr-run-command-1 workfile command args)
   (let ((directory (directory-pathname workfile)))
@@ -2587,6 +2574,27 @@ the value of vc-log-mode-hook."
 		     'working-directory directory)))
 	       (and (eqv? status 0)
 		    (get-output-string port))))))))
+
+(define (get-bzr-status workfile #!optional required?)
+  (let ((workfile
+	 (if (vc-master? workfile)
+	     (vc-master-workfile workfile)
+	     workfile)))
+    (or (parse-bzr-status (%get-bzr-status workfile))
+	(cond ((bzr-workfile-versioned? workfile)
+	       (make-bzr-status 'VERSIONED 'UNMODIFIED #f))
+	      ((bzr-workfile-ignored? workfile)
+	       (make-bzr-status 'UNVERSIONED 'UNMODIFIED #f))
+	      ((bzr-workfile-unknown? workfile)
+	       (make-bzr-status 'UNKNOWN 'UNMODIFIED #f))
+	      (else
+	       (if (if (default-object? required?) #f required?)
+		   (error "Unable to determine Bazaar status of file:"
+			  workfile))
+	       #f)))))
+
+(define (%get-bzr-status workfile)
+  (%bzr-run-command workfile "status" "--short" (file-namestring workfile)))
 
 (define (parse-bzr-status status)
   (and status