Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding basic process and system tests, with some fixes

Browse source
This commit is contained in:
Alex Shinn 2011-11-24 10:11:12 +09:00
parent e1731fabf3
commit 4d23c1e7c5
5 changed files with 29 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Makefile
View file

@ -280,6 +280,12 @@ test-weak: chibi-scheme$(EXE) lib/chibi/weak$(SO)
test-unicode: chibi-scheme$(EXE) test-unicode: chibi-scheme$(EXE)
$(CHIBI) tests/unicode-tests.scm $(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) test-libs: chibi-scheme$(EXE)
$(CHIBI) tests/lib-tests.scm $(CHIBI) tests/lib-tests.scm

12
lib/chibi/process.sld
View file

@ -2,9 +2,10 @@
(define-library (chibi process) (define-library (chibi process)
(export exit sleep alarm fork kill execute waitpid system (export exit sleep alarm fork kill execute waitpid system
process-command-line process-running? 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! 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-mask-block! signal-mask-unblock! signal-mask-set!
signal/hang-up signal/interrupt signal/quit signal/hang-up signal/interrupt signal/quit
signal/illegal signal/abort signal/fpe signal/illegal signal/abort signal/fpe
@ -23,7 +24,12 @@
(execute cmd (cons cmd args)) (execute cmd (cons cmd args))
(waitpid pid 0))))) (waitpid pid 0)))))
(cond-expand (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 (else
(body (body
(define (process-command-line pid) (define (process-command-line pid)

13
lib/chibi/process.stub
View file

@ -65,7 +65,7 @@
(define-c errno (make-signal-set "sigemptyset") ((pointer result sigset_t))) (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-fill! "sigfillset") ((pointer sigset_t)))
(define-c errno (signal-set-add! "sigaddset") ((pointer sigset_t) int)) (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 boolean (signal-set-contains? "sigismember") ((pointer sigset_t) int))
(define-c errno (signal-mask-block! "sigprocmask") (define-c errno (signal-mask-block! "sigprocmask")
@ -124,9 +124,18 @@
(define-c int (execute execvp) (string (array string))) (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 (cond-expand
(bsd (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)) (else #f))
(c-init "sexp_init_signals(ctx, env);") (c-init "sexp_init_signals(ctx, env);")

2
tests/lib-tests.scm
View file

@ -19,6 +19,8 @@
(load "tests/hash-tests.scm") (load "tests/hash-tests.scm")
(load "tests/sort-tests.scm") (load "tests/sort-tests.scm")
(load "tests/io-tests.scm") (load "tests/io-tests.scm")
(load "tests/process-tests.scm")
(load "tests/system-tests.scm")
(load "tests/thread-tests.scm"))) (load "tests/thread-tests.scm")))
(else #f)) (else #f))

2
tools/chibi-ffi
View file

@ -439,7 +439,7 @@
(else (else
(string-append (string-append
"sexp_unbox_fixnum(sexp_vector_ref(sexp_opcode_argn_type(self), " "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")))) (else "SEXP_OBJECT"))))
(define (type-id-value type . o) (define (type-id-value type . o)