From 1e59826d64659fcf40a7469bab2132f150d675f2 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 18 Oct 2007 15:57:40 +0000 Subject: [PATCH] Fix bzr command cache to pay attention to timestamp of workfile. --- v7/src/edwin/vc.scm | 74 +++++++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 33 deletions(-) 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 -- 2.25.1