>>>>> "Ed" == Ed Kademan <kademan@phz.com> writes:
Ed> I am using Solaris2.6. There seems to be some weird interaction
Ed> between the `with-cwd' form and `create-symlink.' In what follows
Ed> there is no directory entry named "new" in either /tmp or
Ed> /home/kademan/tmp initially.
Ed> Welcome to scsh 0.6.1 (Combinatorial Algorithms)
Ed> Type ,? for help.
Ed> ;; This creates a symlink named "new" in /tmp as expected.
>> (with-cwd "/tmp" (create-symlink "old" "new"))
Ed> ;; But now I can't seem to create a symlink in my default current
Ed> ;; directory.
>> (run (pwd))
Ed> /home/kademan/tmp
Ed> 0
>> (create-symlink "old" "new")
Ed> Error: 17
>> #{Procedure 11533 (create-symlink in scsh-level-0)}
>> "new"
1>
Ed> ;; However I can create the symlink if I am explicit about where it
Ed> ;; goes.
>> (create-symlink "old" "/home/kademan/tmp/new")
>>
The following patch should fix the problem:
Index: filesys.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/filesys.scm,v
retrieving revision 1.3
diff -c -r1.3 filesys.scm
*** filesys.scm 19 Feb 2002 17:18:45 -0000 1.3
--- filesys.scm 5 Mar 2002 16:43:29 -0000
***************
*** 37,63 ****
;;; Abstract out common code for create-{directory,fifo,hard-link,symlink}:
(define (create-file-thing fname makeit override? op-name syscall)
! (let ((query (lambda ()
! (y-or-n? (string-append op-name ": " fname
! " already exists. Delete")))))
! (let ((result
! (let loop ((override? override?))
! (with-errno-handler
! ((err data)
! ((errno/exist)
! (cond ((if (eq? override? 'query)
! (query)
! override?)
! (delete-filesys-object fname)
! (loop #t))
;;; raising an error here won't work due to S48's
;;; broken exception system
! (else (list err syscall fname)))))
! (makeit fname)
! #f))))
! (if (list? result)
! (apply errno-error result)
! (if #f #f)))))
;;;;;;;
--- 37,65 ----
;;; Abstract out common code for create-{directory,fifo,hard-link,symlink}:
(define (create-file-thing fname makeit override? op-name syscall)
! (with-cwd-aligned
! (with-umask-aligned
! (let ((query (lambda ()
! (y-or-n? (string-append op-name ": " fname
! " already exists. Delete")))))
! (let ((result
! (let loop ((override? override?))
! (with-errno-handler
! ((err data)
! ((errno/exist)
! (cond ((if (eq? override? 'query)
! (query)
! override?)
! (delete-filesys-object fname)
! (loop #t))
;;; raising an error here won't work due to S48's
;;; broken exception system
! (else (list err syscall fname)))))
! (makeit fname)
! #f))))
! (if (list? result)
! (apply errno-error result)
! (if #f #f)))))))
;;;;;;;
***************
*** 106,115 ****
;;; us not to. That's life in the food chain.
(define (rename-file old-fname new-fname . maybe-override?)
! (let ((override? (:optional maybe-override? #f)))
! (if (or (and override? (not (eq? override? 'query)))
! (file-not-exists? new-fname)
! (and override?
! (y-or-n? (string-append "rename-file:" new-fname
! " already exists. Delete"))))
! (%rename-file old-fname new-fname))))
--- 108,118 ----
;;; us not to. That's life in the food chain.
(define (rename-file old-fname new-fname . maybe-override?)
! (with-cwd-aligned
! (let ((override? (:optional maybe-override? #f)))
! (if (or (and override? (not (eq? override? 'query)))
! (file-not-exists? new-fname)
! (and override?
! (y-or-n? (string-append "rename-file:" new-fname
! " already exists. Delete"))))
! (%rename-file old-fname new-fname)))))
--
Martin
|