suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Places: check arguments

Browse Source
This commit is contained in:
Kevin Tew 2010-09-07 15:29:08 -06:00
parent 732c62b2a5
commit 324a0ce815
5 changed files with 72 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/meta/props
View File

@ -1779,6 +1779,7 @@ path/s is either such a string or a list of them.
"collects/tests/racket/pathlib.rktl" drdr:command-line (racket "-f" *)
"collects/tests/racket/pconvert.rktl" drdr:command-line #f
"collects/tests/racket/place-channel.rktl" drdr:command-line #f
"collects/tests/racket/place.rktl" drdr:command-line #f
"collects/tests/racket/port.rktl" drdr:command-line #f
"collects/tests/racket/portlib.rktl" drdr:command-line #f
"collects/tests/racket/pretty.rktl" drdr:command-line (racket "-f" *)

12
collects/tests/racket/benchmarks/places/place-utils.rkt
View File

@ -43,8 +43,8 @@
(lambda (out)
(write txt out))))
(define module-path-prefix (make-temporary-file "place-worker-~a.rkt" #f))
(define-values (base file-name isdir) (split-path module-path-prefix))
(define module-path (make-temporary-file "place-worker-~a.rkt" #f))
(define-values (base file-name isdir) (split-path module-path))
(define worker-syntax
(with-syntax ([module-name (datum->syntax #'name (string->symbol (path->string (path-replace-suffix file-name ""))))])
#'(module module-name racket/base
@ -52,12 +52,12 @@
(provide name)
(define (name ch)
body ...))))
(define module-path (path->string module-path-prefix))
(define module-path-str (path->string module-path))
(splat (syntax->datum worker-syntax) module-path)
(splat (syntax->datum worker-syntax) module-path-str)
(define place-syntax #`(place (make-resolved-module-path #,module-path) (quote name)))
;(write (syntax->datum place-syntax))
(define place-syntax #`(place #,module-path (quote name)))
;(write (syntax->datum place-syntax)) (newline)
place-syntax)]))
(define-syntax (time-n stx)

7
collects/tests/racket/place-channel.rktl
View File

@ -9,9 +9,12 @@
(splat
#<<END
(module pct1 scheme
(module pct1 racket/base
(provide place-main)
(require racket/flonum)
(require racket/flonum
racket/place
racket/list
(for-syntax racket/base))
(define-syntax (pcrs stx)
(syntax-case stx ()

33
collects/tests/racket/place.rktl Normal file
View File

@ -0,0 +1,33 @@
(load-relative "loadtest.rktl")
(Section 'places)
(require "benchmarks/places/place-utils.rkt")
(place-wait (place/base (p1 ch)
(printf "Hello from place\n")))
(let ([p (place/base (p1 ch)
(printf "Hello form place 2\n"))])
(test #f place? 1)
(test #f place? void)
(test #t place? p)
(err/rt-test (place-wait 1))
(err/rt-test (place-wait void))
(test 0 place-wait p)
)
(arity-test place 2 2)
(arity-test place-wait 1 1)
(arity-test place-channel 0 0)
(arity-test place-channel-send 2 2)
(arity-test place-channel-recv 1 1)
(arity-test place-channel? 1 1)
(arity-test place? 1 1)
(arity-test place-channel-send/recv 2 2)
(arity-test processor-count 0 0)
(err/rt-test (place "foo.rkt"))
(err/rt-test (place null 10))
(err/rt-test (place "foo.rkt" 10))

31
src/racket/src/places.c
View File

@ -167,6 +167,14 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
if (argc == 2) {
Scheme_Object *so;
if (!scheme_is_module_path(args[0]) && !SCHEME_PATHP(args[0])) {
scheme_wrong_type("place", "module-path or path", 0, argc, args);
}
if (!SCHEME_SYMBOLP(args[1])) {
scheme_wrong_type("place", "symbol", 1, argc, args);
}
so = scheme_places_deep_copy_to_master(args[0]);
place_data->module = so;
so = scheme_places_deep_copy_to_master(args[1]);
@ -628,6 +636,13 @@ static int place_wait_ready(Scheme_Object *o) {
static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]) {
Scheme_Place *place;
place = (Scheme_Place *) args[0];
if (argc != 1) {
scheme_wrong_count_m("place-wait", 1, 1, argc, args, 0);
}
if (!SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
scheme_wrong_type("place-wait", "place", 0, argc, args);
}
# ifdef MZ_PRECISE_GC
{
@ -1145,8 +1160,12 @@ Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) {
if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) args[0])->channel;
}
else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
ch = (Scheme_Place_Bi_Channel *) args[0];
}
else {
ch = (Scheme_Place_Bi_Channel *)args[0];
ch = NULL;
scheme_wrong_type("place-channel-send", "place-channel", 0, argc, args);
}
{
void *msg_memory;
@ -1155,7 +1174,7 @@ Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) {
}
}
else {
scheme_wrong_count_m("place-channel-send", 1, 2, argc, args, 0);
scheme_wrong_count_m("place-channel-send", 2, 2, argc, args, 0);
}
return scheme_true;
}
@ -1167,9 +1186,13 @@ Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]) {
if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) args[0])->channel;
}
else {
else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
ch = (Scheme_Place_Bi_Channel *) args[0];
}
else {
ch = NULL;
scheme_wrong_type("place-channel-recv", "place-channel", 0, argc, args);
}
{
void *msg_memory;
mso = scheme_place_async_recv((Scheme_Place_Async_Channel *) ch->recvch, &msg_memory);
@ -1177,7 +1200,7 @@ Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]) {
}
}
else {
scheme_wrong_count_m("place-channel-recv", 1, 2, argc, args, 0);
scheme_wrong_count_m("place-channel-recv", 1, 1, argc, args, 0);
}
return scheme_true;
}