From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Aug 2007 17:26:38 +0000 (+0000)
Subject: Don't call UNIX/CURRENT-UID on non-unix systems.
X-Git-Tag: 20090517-FFI~455
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=81e3108015a9cef642a7d2cace468f612e0e6a32;p=mit-scheme.git

Don't call UNIX/CURRENT-UID on non-unix systems.
---

diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 4a43c7c3e..f5c1a7d44 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vc.scm,v 1.98 2007/01/14 01:58:12 cph Exp $
+$Id: vc.scm,v 1.99 2007/08/22 17:26:38 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -91,12 +91,16 @@ This can be overriden by giving a prefix argument to \\[vc-register]."
   "An event distributor that is invoked after a checkin is done."
   (make-event-distributor))
 
+(define (user-is-root?)
+  (and (eq? microcode-id/operating-system 'unix)
+       (= (unix/current-uid) 0)))
+
 (define-variable vc-checkout-carefully
   "True means be extra-careful in checkout.
 Verify that the file really is not locked
 and that its contents match what the master file says."
   ;; Default is to be extra careful for super-user.
-  (lambda () (= (unix/current-uid) 0))
+  user-is-root?
   (lambda (object)
     (or (boolean? object)
 	(and (procedure? object)
@@ -359,7 +363,7 @@ Otherwise, VC will compare the file to the copy in the repository."
 		     ;; even though we can (because root can write
 		     ;; anything).  This way, even root cannot modify a file
 		     ;; that isn't locked.
-		     (and (= 0 (unix/current-uid))
+		     (and (user-is-root?)
 			  (fix:= 0
 				 (fix:and #o200
 					  (file-modes