From 4d23c1e7c58df4c6dd5a952955f1ed6cb72e0fb7 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Thu, 24 Nov 2011 10:11:12 +0900
Subject: [PATCH] adding basic process and system tests, with some fixes
---
Makefile | 6 ++++++
lib/chibi/process.sld | 12 +++++++++---
lib/chibi/process.stub | 13 +++++++++++--
tests/lib-tests.scm | 2 ++
tools/chibi-ffi | 2 +-
5 files changed, 29 insertions(+), 6 deletions(-)
diff --git a/Makefile b/Makefile
index 56b1bb84..a8fa39dc 100644
--- a/Makefile
+++ b/Makefile
@@ -280,6 +280,12 @@ test-weak: chibi-scheme$(EXE) lib/chibi/weak$(SO)
test-unicode: chibi-scheme$(EXE)
$(CHIBI) tests/unicode-tests.scm
+test-process: chibi-scheme$(EXE) lib/chibi/process$(SO)
+ $(CHIBI) tests/process-tests.scm
+
+test-system: chibi-scheme$(EXE) lib/chibi/system$(SO)
+ $(CHIBI) tests/system-tests.scm
+
test-libs: chibi-scheme$(EXE)
$(CHIBI) tests/lib-tests.scm
diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld
index 59049795..ec40010d 100644
--- a/lib/chibi/process.sld
+++ b/lib/chibi/process.sld
@@ -2,9 +2,10 @@
(define-library (chibi process)
(export exit sleep alarm fork kill execute waitpid system
process-command-line process-running?
- set-signal-action! make-signal-set signal-set-contains?
+ set-signal-action! make-signal-set
+ signal-set? signal-set-contains?
signal-set-fill! signal-set-add! signal-set-delete!
- current-signal-mask
+ current-signal-mask current-process-id parent-process-id
signal-mask-block! signal-mask-unblock! signal-mask-set!
signal/hang-up signal/interrupt signal/quit
signal/illegal signal/abort signal/fpe
@@ -23,7 +24,12 @@
(execute cmd (cons cmd args))
(waitpid pid 0)))))
(cond-expand
- (bsd #f)
+ (bsd
+ (body
+ (define (process-command-line pid)
+ (let ((res (%process-command-line pid)))
+ ;; TODO: get command-line arguments
+ (if (string? res) (list res) res)))))
(else
(body
(define (process-command-line pid)
diff --git a/lib/chibi/process.stub b/lib/chibi/process.stub
index d84f9f14..fca6db84 100644
--- a/lib/chibi/process.stub
+++ b/lib/chibi/process.stub
@@ -65,7 +65,7 @@
(define-c errno (make-signal-set "sigemptyset") ((pointer result sigset_t)))
(define-c errno (signal-set-fill! "sigfillset") ((pointer sigset_t)))
(define-c errno (signal-set-add! "sigaddset") ((pointer sigset_t) int))
-(define-c errno (signal-set-delete! "sigaddset") ((pointer sigset_t) int))
+(define-c errno (signal-set-delete! "sigdelset") ((pointer sigset_t) int))
(define-c boolean (signal-set-contains? "sigismember") ((pointer sigset_t) int))
(define-c errno (signal-mask-block! "sigprocmask")
@@ -124,9 +124,18 @@
(define-c int (execute execvp) (string (array string)))
+;;> Returns the current process id.
+
+(define-c pid_t (current-process-id getpid) ())
+
+;;> Returns the parent process id.
+
+(define-c pid_t (parent-process-id getppid) ())
+
(cond-expand
(bsd
- (define-c sexp (process-command-line sexp_pid_cmdline) ((value ctx sexp) int)))
+ (define-c sexp (%process-command-line sexp_pid_cmdline)
+ ((value ctx sexp) int)))
(else #f))
(c-init "sexp_init_signals(ctx, env);")
diff --git a/tests/lib-tests.scm b/tests/lib-tests.scm
index 6f3329b7..83bc8839 100644
--- a/tests/lib-tests.scm
+++ b/tests/lib-tests.scm
@@ -19,6 +19,8 @@
(load "tests/hash-tests.scm")
(load "tests/sort-tests.scm")
(load "tests/io-tests.scm")
+ (load "tests/process-tests.scm")
+ (load "tests/system-tests.scm")
(load "tests/thread-tests.scm")))
(else #f))
diff --git a/tools/chibi-ffi b/tools/chibi-ffi
index b9bfd5cf..ec917425 100755
--- a/tools/chibi-ffi
+++ b/tools/chibi-ffi
@@ -439,7 +439,7 @@
(else
(string-append
"sexp_unbox_fixnum(sexp_vector_ref(sexp_opcode_argn_type(self), "
- (number->string (- i 3)) "))")))))
+ "sexp_make_fixnum("(number->string (- i 3)) ")))")))))
(else "SEXP_OBJECT"))))
(define (type-id-value type . o)