conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Applied patch for "make-hard-link". Thanks to Andreas Rottmann.

This commit is contained in:
Abdulaziz Ghuloum 2009-01-03 20:36:53 -05:00
parent 71c707df50
commit 2adc9cb85d
4 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
scheme/ikarus.posix.ss
View File

@ -21,7 +21,7 @@
nanosleep getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory? file-readable?
file-writable? file-executable? file-size rename-file
file-symbolic-link? make-symbolic-link directory-list
file-symbolic-link? make-symbolic-link make-hard-link directory-list
make-directory delete-directory change-mode kill strerror
wstatus-pid wstatus-exit-status wstatus-received-signal)
@ -32,7 +32,7 @@
delete-file getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory?
file-readable? file-writable? file-executable? file-size
rename-file file-symbolic-link? make-symbolic-link
rename-file file-symbolic-link? make-symbolic-link make-hard-link
directory-list make-directory delete-directory change-mode
kill strerror wstatus-pid wstatus-exit-status
wstatus-received-signal))
@ -278,15 +278,22 @@
(unless (eq? r #t)
(raise/strerror who r path)))))
(define make-symbolic-link
(lambda (to path)
(define who 'make-symbolic-link)
(unless (and (string? to) (string? path))
(die who "not a string" (if (string? to) path to)))
(let ([r (foreign-call "ikrt_symlink"
(string->utf8 to) (string->utf8 path))])
(unless (eq? r #t)
(raise/strerror who r path)))))
(define ($make-link to path who proc)
(unless (and (string? to) (string? path))
(die who "not a string" (if (string? to) path to)))
(let ([r (proc (string->utf8 to) (string->utf8 path))])
(unless (eq? r #t)
(raise/strerror who r path))))
(define (make-symbolic-link to path)
($make-link to path 'make-symbolic-link
(lambda (u-to u-path)
(foreign-call "ikrt_symlink" u-to u-path))))
(define (make-hard-link to path)
($make-link to path 'make-hard-link
(lambda (u-to u-path)
(foreign-call "ikrt_link" u-to u-path))))
(define ($file-time x who proc)
(unless (string? x)

2
scheme/last-revision
View File

@ -1 +1 @@
1739
1740

1
scheme/makefile.ss
View File

@ -1273,6 +1273,7 @@
[delete-directory i]
[change-mode i]
[make-symbolic-link i]
[make-hard-link i]
[file-ctime i]
[file-mtime i]
[file-size i]

8
src/ikarus-runtime.c
View File

@ -679,6 +679,14 @@ ikrt_symlink(ikptr to, ikptr path /*, ikpcb* pcb */){
return ik_errno_to_code();
}
ikptr
ikrt_link(ikptr to, ikptr path /*, ikpcb* pcb */){
int r = link((char*)(to+off_bytevector_data), (char*)(path+off_bytevector_data));
if(r == 0){
return true_object;
}
return ik_errno_to_code();
}
ikptr
ik_system(ikptr str){