~ chicken-core (chicken-5) b47023ce8e4568eab48e72c0256fd6bc1db12e74
commit b47023ce8e4568eab48e72c0256fd6bc1db12e74
Author: Kristian Lein-Mathisen <kristian@adellica.com>
AuthorDate: Thu May 3 14:52:20 2018 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 13 15:33:41 2018 +0200
Fixes namespaces of chicken.process-context.posix exports
These identifiers were exporting undefined values.
Note that the lambda-info of these procedures are now incorrectly
missing the namespace prefix. Let's address in a separate commit.
Signed-off-by: Kooda <kooda@upyum.com>
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/library.scm b/library.scm
index d05d85c2..47648ea3 100644
--- a/library.scm
+++ b/library.scm
@@ -5930,7 +5930,8 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
program-name executable-pathname
change-directory current-directory
get-environment-variable get-environment-variables
- set-environment-variable! unset-environment-variable!)
+ set-environment-variable! unset-environment-variable!
+ current-process-id)
(import scheme)
(import chicken.base chicken.fixnum chicken.foreign)
@@ -6050,6 +6051,9 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
(##sys#check-list x 'command-line-arguments)
x) ) )
+(define current-process-id
+ (foreign-lambda int "C_getpid"))
+
) ; chicken.process-context
diff --git a/posix-common.scm b/posix-common.scm
index ea8cf78d..6b22a54b 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -600,8 +600,6 @@ EOF
;;; Processes
-(define current-process-id (foreign-lambda int "C_getpid"))
-
(set! chicken.process#process-sleep
(lambda (n)
(##sys#check-fixnum n 'process-sleep)
diff --git a/posix.scm b/posix.scm
index 6ef41dfb..ba14855d 100644
--- a/posix.scm
+++ b/posix.scm
@@ -320,7 +320,7 @@
(module chicken.process-context.posix
(change-directory* set-root-directory!
current-effective-group-id current-effective-user-id
- current-group-id current-process-id current-user-id
+ current-group-id current-user-id
parent-process-id current-user-name
current-effective-user-name create-session
process-group-id user-information)
@@ -332,7 +332,6 @@
(define current-effective-group-id)
(define current-effective-user-id)
(define current-group-id)
-(define current-process-id)
(define current-user-id)
(define parent-process-id)
(define current-user-name)
diff --git a/posixunix.scm b/posixunix.scm
index 3fd30dbd..a4995598 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -606,7 +606,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Getting group- and user-information:
-(define current-user-id
+(set! chicken.process-context.posix#current-user-id
(getter-with-setter
(foreign-lambda int "C_getuid")
(lambda (id)
@@ -615,7 +615,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#error 'current-user-id!-setter "cannot set user ID" id) ) )
"(current-user-id)"))
-(define current-effective-user-id
+(set! chicken.process-context.posix#current-effective-user-id
(getter-with-setter
(foreign-lambda int "C_geteuid")
(lambda (id)
@@ -625,7 +625,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
'effective-user-id!-setter "cannot set effective user ID" id) ) )
"(current-effective-user-id)"))
-(define current-group-id
+(set! chicken.process-context.posix#current-group-id
(getter-with-setter
(foreign-lambda int "C_getgid")
(lambda (id)
@@ -634,7 +634,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#error 'current-group-id!-setter "cannot set group ID" id) ) )
"(current-group-id)") )
-(define current-effective-group-id
+(set! chicken.process-context.posix#current-effective-group-id
(getter-with-setter
(foreign-lambda int "C_getegid")
(lambda (id)
@@ -652,27 +652,32 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-foreign-variable _user-dir c-string "C_user->pw_dir")
(define-foreign-variable _user-shell c-string "C_user->pw_shell")
-(define (user-information user #!optional as-vector)
- (let ([r (if (fixnum? user)
- (##core#inline "C_getpwuid" user)
- (begin
- (##sys#check-string user 'user-information)
- (##core#inline "C_getpwnam" (##sys#make-c-string user 'user-information)) ) ) ] )
- (and r
- ((if as-vector vector list)
- _user-name
- _user-passwd
- _user-uid
- _user-gid
- _user-gecos
- _user-dir
- _user-shell) ) ) )
-
-(define (current-user-name)
- (car (user-information (current-user-id))) )
-
-(define (current-effective-user-name)
- (car (user-information (current-effective-user-id))) )
+(set! chicken.process-context.posix#user-information
+ (lambda (user #!optional as-vector)
+ (let ([r (if (fixnum? user)
+ (##core#inline "C_getpwuid" user)
+ (begin
+ (##sys#check-string user 'user-information)
+ (##core#inline "C_getpwnam" (##sys#make-c-string user 'user-information)) ) ) ] )
+ (and r
+ ((if as-vector vector list)
+ _user-name
+ _user-passwd
+ _user-uid
+ _user-gid
+ _user-gecos
+ _user-dir
+ _user-shell) ) )) )
+
+(set! chicken.process-context.posix#current-user-name
+ (lambda ()
+ (car (chicken.process-context.posix#user-information
+ (chicken.process-context.posix#current-user-id)))) )
+
+(set! chicken.process-context.posix#current-effective-user-name
+ (lambda ()
+ (car (chicken.process-context.posix#user-information
+ (chicken.process-context.posix#current-effective-user-id)))) )
(define chown
(lambda (loc f uid gid)
@@ -692,14 +697,15 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(when (fx< r 0)
(posix-error #:file-error loc "cannot change file owner" f uid gid) )) ) )
-(define (create-session)
- (let ([a (##core#inline "C_setsid" #f)])
- (when (fx< a 0)
- (##sys#update-errno)
- (##sys#error 'create-session "cannot create session") )
- a) )
+(set! chicken.process-context.posix#create-session
+ (lambda ()
+ (let ([a (##core#inline "C_setsid" #f)])
+ (when (fx< a 0)
+ (##sys#update-errno)
+ (##sys#error 'create-session "cannot create session") )
+ a)) )
-(define process-group-id
+(set! chicken.process-context.posix#process-group-id
(getter-with-setter
(lambda (pid)
(##sys#check-fixnum pid 'process-group-id)
@@ -1120,7 +1126,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##core#inline "C_WTERMSIG" _wait-status))
(else (##core#inline "C_WSTOPSIG" _wait-status)) ) )) ) )
-(define parent-process-id (foreign-lambda int "C_getppid"))
+(set! chicken.process-context.posix#parent-process-id (foreign-lambda int "C_getppid"))
(set! chicken.process#process-signal
(lambda (id . sig)
@@ -1276,7 +1282,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; chroot:
-(define set-root-directory!
+(set! chicken.process-context.posix#set-root-directory!
(let ([chroot (foreign-lambda int "chroot" c-string)])
(lambda (dir)
(##sys#check-string dir 'set-root-directory!)
diff --git a/posixwin.scm b/posixwin.scm
index fef66b8f..a20ead2f 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -863,12 +863,13 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-foreign-variable _username c-string "C_username")
-(define (current-user-name)
- (if (##core#inline "C_get_user_name")
- _username
- (begin
- (##sys#update-errno)
- (##sys#error 'current-user-name "cannot retrieve current user-name") ) ) )
+(set! chicken.process-context.posix#current-user-name
+ (lambda ()
+ (if (##core#inline "C_get_user_name")
+ _username
+ (begin
+ (##sys#update-errno)
+ (##sys#error 'current-user-name "cannot retrieve current user-name") ) ) ) )
;;; unimplemented stuff:
@@ -882,6 +883,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(set!-unimplemented chicken.process-context.posix#current-effective-user-name)
(set!-unimplemented chicken.process-context.posix#current-group-id)
(set!-unimplemented chicken.process-context.posix#current-user-id)
+(set!-unimplemented chicken.process-context.posix#user-information)
(set!-unimplemented chicken.file.posix#file-control)
(set!-unimplemented chicken.file.posix#file-link)
(set!-unimplemented chicken.file.posix#file-lock)
diff --git a/types.db b/types.db
index 69f6209f..256cfff9 100644
--- a/types.db
+++ b/types.db
@@ -1922,6 +1922,7 @@
(chicken.process-context#program-name (#(procedure #:clean #:enforce) chicken.process-context#program-name (#!optional string) string))
(chicken.process-context#set-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#set-environment-variable! (string string) undefined))
(chicken.process-context#unset-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#unset-environment-variable! (string) undefined))
+(chicken.process-context#current-process-id (#(procedure #:clean) chicken.process-context#current-process-id () fixnum))
;; process-context.posix
@@ -1932,7 +1933,6 @@
(chicken.process-context.posix#current-effective-user-id (#(procedure #:clean) chicken.process-context.posix#current-effective-user-id () fixnum))
(chicken.process-context.posix#current-effective-user-name (#(procedure #:clean) chicken.process-context.posix#current-effective-user-name () string))
(chicken.process-context.posix#current-group-id (#(procedure #:clean) chicken.process-context.posix#current-group-id () fixnum))
-(chicken.process-context.posix#current-process-id (#(procedure #:clean) chicken.process-context.posix#current-process-id () fixnum))
(chicken.process-context.posix#current-user-id (#(procedure #:clean) chicken.process-context.posix#current-user-id () fixnum))
(chicken.process-context.posix#current-user-name (#(procedure #:clean) chicken.process-context.posix#current-user-name () string))
(chicken.process-context.posix#parent-process-id (#(procedure #:clean) chicken.process-context.posix#parent-process-id () fixnum))
Trap