Hi,
On Tue, 19 Mar 2013 16:44:24 +0100 Peter Bex <peter....@xs4all.nl> wrote:
> On Fri, Mar 15, 2013 at 07:58:02AM +0100, Florian Zumbiehl wrote:
>> Remove ##sys#expand-home-path as shell expansion has no place in a filesystem
>> API.
>
> I've moved the ~ behaviour to a new procedure in "utils" called "ep" and
> updated the NEWS file and docs.
>
> The signed off patch is attached.
>
> I'm not 100% sure how to handle this, as it's a backwards-incompatible
> change. Pushing it as-is could possibly cause breakage in existing
> programs, but it will also fix programs that don't knowingly rely on
> this behaviour.
>
> BTW: This behaviour isn't really compatible with the shell's, since it
> disallows strings formatted like ~username from being expanded to that
> user's homedir. The shell would expand ~ to the current user's homedir
> only in a string where it's immediately succeeded by a slash, like ~/foo.
> This will now expand to the current user's homedir with foo pasted at
> the end, like "/home/peterfoo". I don't know if this is a bug or
> intended behaviour, so I kept it the way it was before.
Thanks. Attached is the patch amended with the following changes:
- Manual: remove "Pathnames expansion" section from the "Extensions to
the standard" chapter
- Remove some trailing whitespaces from the new code
- Mention ep in the commit log
- Fix tests that check the ~-expansion
I haven't pushed this patch, since we don't have a consensus on how to
handle this issue and since it is possible that the fix for it will
cause some breakage. So, I'm afraid we should file a change request.
Here is a summary of options I've collected from this thread:
a. Keep ##sys#expand-home-path, but remove the environment variable
expansion. Keep the ~-expansion.
b. Drop ##sys#expand-home-path. Do not implicitly expand ~ and
environment variables in pathnames. Provide a procedure to expand ~
in pathnames. That's what this patch implements.
c. Drop ##sys#expand-home-path. Do not implicitly expand ~ and
environment variables in pathnames. Provide an egg to implement the
old behavior of the procedures from the filesystem API.
Any other relevant options?
If you think a CR is required, I can create one.
Best wishes.
Mario
--
http://parenteses.org/mario
>From 1649e7f4a35cbd5a211380e7241b2ac9b0fb9dc2 Mon Sep 17 00:00:00 2001
From: Florian Zumbiehl <fl...@florz.de>
Date: Fri, 15 Mar 2013 07:58:02 +0100
Subject: [PATCH] Remove ##sys#expand-home-path.
Remove ##sys#expand-home-path as shell expansion has no place in a filesystem
API.
Add a new procedure (ep) to expand ~ to the user home directory if it
is the first character of the given pathname. Differently
from ##sys#expand-home-path, ep doesn't expand environment variables
when pathnames start with $ and is not implicitly called from the
filesystem-related procedures.
Signed-off-by: Peter Bex <peter....@xs4all.nl>
Signed-off-by: Mario Domenech Goulart <mario.goul...@gmail.com>
---
NEWS | 3 +
eval.scm | 2 -
files.scm | 14 ++---
library.scm | 123 ++++++++++++-------------------------
manual/Extensions to the standard | 6 --
manual/Unit utils | 13 ++++
posix-common.scm | 35 +++++------
posixunix.scm | 45 +++++++-------
posixwin.scm | 12 ++--
tests/path-tests.scm | 9 +--
utils.scm | 12 ++++
11 files changed, 120 insertions(+), 154 deletions(-)
diff --git a/NEWS b/NEWS
index c2d16fb..bfb7a6e 100644
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,9 @@
- Security fixes
- ./.csirc is no longer loaded from the current directory upon startup of csi,
which could lead to untrusted code execution. (thanks to Florian Zumbiehl)
+ - Path operations no longer implicitly expand ~ and shell variables at the
+ start of a string. ~-expansion can now be done explicitly through a
+ new "EP" procedure from unit utils. (thanks to Florian Zumbiehl)
- Tools
- csc: added "-oi"/"-ot" options as alternatives to "-emit-inline-file"
diff --git a/eval.scm b/eval.scm
index 62227cd..e92d6f7 100644
--- a/eval.scm
+++ b/eval.scm
@@ -940,8 +940,6 @@
(##sys#signal-hook #:type-error 'load "bad argument type - not a port or string" x) )
(set! ##sys#load
(lambda (input evaluator pf #!optional timer printer)
- (when (string? input)
- (set! input (##sys#expand-home-path input)) )
(let* ((fname
(cond [(port? input) #f]
[(not (string? input)) (badfile input)]
diff --git a/files.scm b/files.scm
index 7398350..cb58000 100644
--- a/files.scm
+++ b/files.scm
@@ -383,14 +383,12 @@ EOF
(display p out) )
(cdr parts))
(when (fx= i prev) (##sys#write-char-0 sep out))
- (let* ((r1 (get-output-string out))
- (r (##sys#expand-home-path r1)))
- (when (string=? r1 r)
- (when abspath
- (set! r (##sys#string-append (string sep) r)))
- (when drive
- (set! r (##sys#string-append drive r))))
- r))))
+ (let ((r (get-output-string out)))
+ (when abspath
+ (set! r (##sys#string-append (string sep) r)))
+ (when drive
+ (set! r (##sys#string-append drive r)))
+ r))))
((*char-pds? (string-ref path i))
(when (and (null? parts) (fx= i prev))
(set! abspath #t))
diff --git a/library.scm b/library.scm
index 5a2862e..3040a1d 100644
--- a/library.scm
+++ b/library.scm
@@ -1934,30 +1934,6 @@ EOF
name) )
name) ) ) )
-(define (##sys#pathname-resolution name thunk . _)
- (thunk (##sys#expand-home-path name)) )
-
-(define ##sys#expand-home-path
- (lambda (path)
- (let ((len (##sys#size path)))
- (if (fx> len 0)
- (case (##core#inline "C_subchar" path 0)
- ((#\~)
- (let ((rest (##sys#substring path 1 len)))
- (##sys#string-append (or (get-environment-variable "HOME") "") rest) ) )
- ((#\$)
- (let loop ((i 1))
- (if (fx>= i len)
- path
- (let ((c (##core#inline "C_subchar" path i)))
- (if (or (eq? c #\/) (eq? c #\\))
- (##sys#string-append
- (or (get-environment-variable (##sys#substring path 1 i)) "")
- (##sys#substring path i len))
- (loop (fx+ i 1)) ) ) ) ) )
- (else path) )
- "") ) ) )
-
(define open-input-file)
(define open-output-file)
(define close-input-port)
@@ -1967,28 +1943,24 @@ EOF
(define (open name inp modes loc)
(##sys#check-string name loc)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (let ([fmode (if inp "r" "w")]
- [bmode ""] )
- (do ([modes modes (##sys#slot modes 1)])
- ((null? modes))
- (let ([o (##sys#slot modes 0)])
- (case o
- [(#:binary) (set! bmode "b")]
- [(#:text) (set! bmode "")]
- [(#:append)
- (if inp
- (##sys#error loc "cannot use append mode with input file")
- (set! fmode "a") ) ]
- [else (##sys#error loc "invalid file option" o)] ) ) )
- (let ([port (##sys#make-port inp ##sys#stream-port-class name 'stream)])
- (unless (##sys#open-file-port port name (##sys#string-append fmode bmode))
- (##sys#update-errno)
- (##sys#signal-hook #:file-error loc (##sys#string-append "cannot open file - " strerror) name) )
- port) ) )
- #:open (not inp) modes) )
+ (let ([fmode (if inp "r" "w")]
+ [bmode ""] )
+ (do ([modes modes (##sys#slot modes 1)])
+ ((null? modes))
+ (let ([o (##sys#slot modes 0)])
+ (case o
+ [(#:binary) (set! bmode "b")]
+ [(#:text) (set! bmode "")]
+ [(#:append)
+ (if inp
+ (##sys#error loc "cannot use append mode with input file")
+ (set! fmode "a") ) ]
+ [else (##sys#error loc "invalid file option" o)] ) ) )
+ (let ([port (##sys#make-port inp ##sys#stream-port-class name 'stream)])
+ (unless (##sys#open-file-port port name (##sys#string-append fmode bmode))
+ (##sys#update-errno)
+ (##sys#signal-hook #:file-error loc (##sys#string-append "cannot open file - " strerror) name) )
+ port) ) )
(define (close port loc)
(##sys#check-port port loc)
@@ -2058,25 +2030,17 @@ EOF
(define (file-exists? name)
(##sys#check-string name 'file-exists?)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (and (##sys#file-exists?
- (##sys#platform-fixup-pathname name)
- #f #f 'file-exists?)
- name) )
- #:exists?) )
+ (and (##sys#file-exists?
+ (##sys#platform-fixup-pathname name)
+ #f #f 'file-exists?)
+ name) )
(define (directory-exists? name)
(##sys#check-string name 'directory-exists?)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (and (##sys#file-exists?
- (##sys#platform-fixup-pathname name)
- #f #t 'directory-exists?)
- name) )
- #:exists?) )
+ (and (##sys#file-exists?
+ (##sys#platform-fixup-pathname name)
+ #f #t 'directory-exists?)
+ name) )
(define (##sys#flush-output port)
((##sys#slot (##sys#slot port 2) 5) port) ; flush-output
@@ -2107,33 +2071,22 @@ EOF
(define (delete-file filename)
(##sys#check-string filename 'delete-file)
- (##sys#pathname-resolution
- filename
- (lambda (filename)
- (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string filename 'delete-file)))
- (##sys#update-errno)
- (##sys#signal-hook
- #:file-error 'delete-file
- (##sys#string-append "cannot delete file - " strerror) filename) )
- filename)
- #:delete) )
+ (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string filename 'delete-file)))
+ (##sys#update-errno)
+ (##sys#signal-hook
+ #:file-error 'delete-file
+ (##sys#string-append "cannot delete file - " strerror) filename) )
+ filename)
(define (rename-file old new)
(##sys#check-string old 'rename-file)
(##sys#check-string new 'rename-file)
- (##sys#pathname-resolution
- old
- (lambda (old)
- (##sys#pathname-resolution
- new
- (lambda (new)
- (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old 'rename-file) (##sys#make-c-string new)))
- (##sys#update-errno)
- (##sys#signal-hook
- #:file-error 'rename-file
- (##sys#string-append "cannot rename file - " strerror) old new) )
- new)))
- #:rename new) )
+ (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old 'rename-file) (##sys#make-c-string new)))
+ (##sys#update-errno)
+ (##sys#signal-hook
+ #:file-error 'rename-file
+ (##sys#string-append "cannot rename file - " strerror) old new) )
+ new)
;;; Decorate procedure with arbitrary data
diff --git a/manual/Extensions to the standard b/manual/Extensions to the standard
index 45fd3ea..4cc34df 100644
--- a/manual/Extensions to the standard
+++ b/manual/Extensions to the standard
@@ -186,12 +186,6 @@ an optional 2nd parameter: if not {{#f}} (which is the default),
toplevel bindings to standard procedures are mutable and new toplevel
bindings may be introduced.
-=== Pathnames expansion
-
-The ''tilde'' character ({{~}}) is automatically expanded in pathnames.
-Additionally, if a pathname starts with {{$VARIABLE...}}, then the prefix is replaced
-by the value of the given environment variable.
-
=== Optional arguments for port-related procedures
If the procedures {{current-input-port}} and
diff --git a/manual/Unit utils b/manual/Unit utils
index 8c1df37..7109988 100644
--- a/manual/Unit utils
+++ b/manual/Unit utils
@@ -47,6 +47,19 @@ characters that would have a special meaning to the shell are escaped
using backslash ({{\}}).
+=== Directory expansion
+
+==== ep
+
+<procedure>(ep PATH)</procedure>
+
+Expands an optional leading {{~}} character in {{PATH}} to the value
+of the {{HOME}} environment variable. If {{$HOME}} is not set, it
+will be expanded to the empty string. This exist since Chicken 4.8.2,
+as a convenience method to emulate earlier implicit behaviour of all
+path procedures.
+
+
=== Dynamic compilation
==== compile-file
diff --git a/posix-common.scm b/posix-common.scm
index 1f7c4b3..f523a07 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -160,7 +160,7 @@ EOF
((string? file)
(let ((path (##sys#make-c-string
(##sys#platform-fixup-pathname
- (##sys#expand-home-path file))
+ file)
loc)))
(if link
(##core#inline "C_lstat" path)
@@ -189,7 +189,7 @@ EOF
(lambda (f t)
(##sys#check-number t 'set-file-modification-time)
(let ((r ((foreign-lambda int "set_file_mtime" c-string scheme-object)
- (##sys#expand-home-path f) t)))
+ f t)))
(when (fx< r 0)
(posix-error
#:file-error 'set-file-modification-time
@@ -323,21 +323,20 @@ EOF
(unless (fx= 0 (##core#inline "C_rmdir" sname))
(posix-error #:file-error 'delete-directory "cannot delete directory" dir) )))
(##sys#check-string name 'delete-directory)
- (let ((name (##sys#expand-home-path name)))
- (if recursive
- (let ((files (find-files ; relies on `find-files' to list dir-contents before dir
- name
- dotfiles: #t
- follow-symlinks: #f)))
- (for-each
- (lambda (f)
- ((cond ((symbolic-link? f) delete-file)
- ((directory? f) rmdir)
- (else delete-file))
- f))
- files)
- (rmdir name))
- (rmdir name)))))
+ (if recursive
+ (let ((files (find-files ; relies on `find-files' to list dir-contents before dir
+ name
+ dotfiles: #t
+ follow-symlinks: #f)))
+ (for-each
+ (lambda (f)
+ ((cond ((symbolic-link? f) delete-file)
+ ((directory? f) rmdir)
+ (else delete-file))
+ f))
+ files)
+ (rmdir name))
+ (rmdir name))))
(define directory
(lambda (#!optional (spec (current-directory)) show-dotfiles?)
@@ -347,7 +346,7 @@ EOF
[entry (##sys#make-pointer)] )
(##core#inline
"C_opendir"
- (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
+ (##sys#make-c-string spec 'directory) handle)
(if (##sys#null-pointer? handle)
(posix-error #:file-error 'directory "cannot open directory" spec)
(let loop ()
diff --git a/posixunix.scm b/posixunix.scm
index 6d1fe51..e35f919 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -608,7 +608,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename) 'file-open) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string filename 'file-open) flags mode)])
(when (eq? -1 fd)
(posix-error #:file-error 'file-open "cannot open file" filename flags mode) )
fd) ) ) ) )
@@ -765,22 +765,21 @@ EOF
(define create-directory
(lambda (name #!optional parents?)
(##sys#check-string name 'create-directory)
- (let ((name (##sys#expand-home-path name)))
- (unless (or (fx= 0 (##sys#size name))
- (file-exists? name))
- (if parents?
- (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
- (if file (make-pathname dir file ext) dir))))
- (when (and dir (not (directory? dir)))
- (loop (pathname-directory dir))
- (*create-directory 'create-directory dir)) )
- (*create-directory 'create-directory name) ) )
- name)))
+ (unless (or (fx= 0 (##sys#size name))
+ (file-exists? name))
+ (if parents?
+ (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
+ (if file (make-pathname dir file ext) dir))))
+ (when (and dir (not (directory? dir)))
+ (loop (pathname-directory dir))
+ (*create-directory 'create-directory dir)) )
+ (*create-directory 'create-directory name) ) )
+ name))
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'change-directory)))
+ (let ((sname (##sys#make-c-string name 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(posix-error #:file-error 'change-directory "cannot change current directory" name) )
name)))
@@ -1205,7 +1204,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname) 'change-file-mode) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
(posix-error #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
(define change-file-owner
@@ -1213,7 +1212,7 @@ EOF
(##sys#check-string fn 'change-file-owner)
(##sys#check-exact uid 'change-file-owner)
(##sys#check-exact gid 'change-file-owner)
- (when (fx< (##core#inline "C_chown" (##sys#make-c-string (##sys#expand-home-path fn) 'change-file-owner) uid gid) 0)
+ (when (fx< (##core#inline "C_chown" (##sys#make-c-string fn 'change-file-owner) uid gid) 0)
(posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) )
(define-foreign-variable _r_ok int "R_OK")
@@ -1223,7 +1222,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename) loc) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
@@ -1263,8 +1262,8 @@ EOF
(##sys#check-string new 'create-symbolic-link)
(when (fx< (##core#inline
"C_symlink"
- (##sys#make-c-string (##sys#expand-home-path old) 'create-symbolic-link)
- (##sys#make-c-string (##sys#expand-home-path new) 'create-symbolic-link) )
+ (##sys#make-c-string old 'create-symbolic-link)
+ (##sys#make-c-string new 'create-symbolic-link) )
0)
(posix-error #:file-error 'create-symbol-link "cannot create symbolic link" old new) ) ) )
@@ -1276,7 +1275,7 @@ EOF
(##sys#check-string fname 'read-symbolic-link)
(let ((len (##core#inline
"C_do_readlink"
- (##sys#make-c-string (##sys#expand-home-path fname) 'read-symbolic-link) buf)))
+ (##sys#make-c-string fname 'read-symbolic-link) buf)))
(if (fx< len 0)
(if canonicalize
fname
@@ -1479,7 +1478,7 @@ EOF
(define file-truncate
(lambda (fname off)
(##sys#check-number off 'file-truncate)
- (when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string (##sys#expand-home-path fname) 'file-truncate) off)]
+ (when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string fname 'file-truncate) off)]
[(fixnum? fname) (##core#inline "C_ftruncate" fname off)]
[else (##sys#error 'file-truncate "invalid file" fname)] )
0)
@@ -1538,7 +1537,7 @@ EOF
(##sys#check-string fname 'create-fifo)
(let ([mode (if (pair? mode) (car mode) (fxior _s_irwxu (fxior _s_irwxg _s_irwxo)))])
(##sys#check-exact mode 'create-fifo)
- (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string (##sys#expand-home-path fname) 'create-fifo) mode) 0)
+ (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string fname 'create-fifo) mode) 0)
(posix-error #:file-error 'create-fifo "cannot create FIFO" fname mode) ) ) ) )
(define fifo?
@@ -1546,7 +1545,7 @@ EOF
(##sys#check-string filename 'fifo?)
(case (##core#inline
"C_i_fifo_p"
- (##sys#make-c-string (##sys#expand-home-path filename) 'fifo?))
+ (##sys#make-c-string filename 'fifo?))
((#t) #t)
((#f) #f)
((0) (##sys#signal-hook #:file-error 'fifo? "file does not exist" filename) )
@@ -1797,7 +1796,7 @@ EOF
(let ([s (car el)])
(##sys#check-string s 'process-execute)
(setenv i s (##sys#size s)) ) ) )
- (let* ([prg (##sys#make-c-string (##sys#expand-home-path filename) 'process-execute)]
+ (let* ([prg (##sys#make-c-string filename 'process-execute)]
[r (if envlist
(##core#inline "C_execve" prg)
(##core#inline "C_execvp" prg) )] )
diff --git a/posixwin.scm b/posixwin.scm
index d2cc927..86515be 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -967,7 +967,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename) 'file-open) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string filename 'file-open) flags mode)])
(when (eq? -1 fd)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'file-open "cannot open file" filename flags mode) )
@@ -1100,7 +1100,7 @@ EOF
(define create-directory
(lambda (name #!optional parents?)
(##sys#check-string name 'create-directory)
- (let ((name (##sys#expand-home-path name)))
+ (let ((name name))
(if parents?
(create-directory-helper-parents name)
(create-directory-helper name))
@@ -1109,7 +1109,7 @@ EOF
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'change-directory)))
+ (let ((sname (##sys#make-c-string name 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(##sys#update-errno)
(##sys#signal-hook
@@ -1309,7 +1309,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname) 'change-file-mode) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname 'change-file-mode) m) 0)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
@@ -1320,7 +1320,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename) loc) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string filename loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
@@ -1530,7 +1530,7 @@ EOF
(build-exec-argvec loc (and arglst ($quote-args-list arglst exactf)) setarg 1)
(build-exec-argvec loc envlst setenv 0)
(##core#inline "C_flushall")
- (##sys#make-c-string (##sys#expand-home-path filename) loc) ) ) )
+ (##sys#make-c-string filename loc) ) ) )
(define ($exec-teardown loc msg filename res)
(##sys#update-errno)
diff --git a/tests/path-tests.scm b/tests/path-tests.scm
index 6b9fc45..045d1f9 100644
--- a/tests/path-tests.scm
+++ b/tests/path-tests.scm
@@ -52,12 +52,9 @@
(test "../../foo" (normalize-pathname "../../foo" 'unix))
(test "c:\\." (normalize-pathname "c:\\" 'windows))
-(define home (get-environment-variable "HOME"))
-
-(when home
- (test (string-append home "/foo") (normalize-pathname "~/foo" 'unix))
- (test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
- (test (string-append home "\\foo") (normalize-pathname "c:~\\foo" 'windows)))
+(test "~/foo" (normalize-pathname "~/foo" 'unix))
+(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
+(test "c:~\\foo" (normalize-pathname "c:~\\foo" 'windows))
(assert (directory-null? "/.//"))
(assert (directory-null? ""))
diff --git a/utils.scm b/utils.scm
index 715219d..9e26757 100644
--- a/utils.scm
+++ b/utils.scm
@@ -75,6 +75,18 @@
(string->list str)))))))
+;;; Expand pathnames for home directory
+(define (ep path)
+ (let ((len (##sys#size path)))
+ (if (fx> len 0)
+ (case (##core#inline "C_subchar" path 0)
+ ((#\~)
+ (let ((rest (##sys#substring path 1 len)))
+ (##sys#string-append (or (get-environment-variable "HOME") "") rest) ) )
+ (else path) )
+ "") ) )
+
+
;;; Compile and load file
(define compile-file-options (make-parameter '("-O2" "-d2")))
--
1.7.10.4
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
