From 324a0ce815702f34a3c01dcecef4a8a1756372eb Mon Sep 17 00:00:00 2001
From: Kevin Tew <tewk@racket-lang.org>
Date: Tue, 7 Sep 2010 15:29:08 -0600
Subject: [PATCH] Places: check arguments

---
 collects/meta/props                           |  1 +
 .../racket/benchmarks/places/place-utils.rkt  | 12 +++----
 collects/tests/racket/place-channel.rktl      |  7 ++--
 collects/tests/racket/place.rktl              | 33 +++++++++++++++++++
 src/racket/src/places.c                       | 31 ++++++++++++++---
 5 files changed, 72 insertions(+), 12 deletions(-)
 create mode 100644 collects/tests/racket/place.rktl

diff --git a/collects/meta/props b/collects/meta/props
index 688076d2c2..cc4ddc9ba3 100755
--- a/collects/meta/props
+++ b/collects/meta/props
@@ -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" *)
diff --git a/collects/tests/racket/benchmarks/places/place-utils.rkt b/collects/tests/racket/benchmarks/places/place-utils.rkt
index 2177edbf60..e80a3fdc86 100644
--- a/collects/tests/racket/benchmarks/places/place-utils.rkt
+++ b/collects/tests/racket/benchmarks/places/place-utils.rkt
@@ -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)
diff --git a/collects/tests/racket/place-channel.rktl b/collects/tests/racket/place-channel.rktl
index 0cbf86a750..0a16827e25 100644
--- a/collects/tests/racket/place-channel.rktl
+++ b/collects/tests/racket/place-channel.rktl
@@ -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 ()
diff --git a/collects/tests/racket/place.rktl b/collects/tests/racket/place.rktl
new file mode 100644
index 0000000000..ffd3717f72
--- /dev/null
+++ b/collects/tests/racket/place.rktl
@@ -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))
+        
+
diff --git a/src/racket/src/places.c b/src/racket/src/places.c
index 16fcfe2935..cbd79e7869 100644
--- a/src/racket/src/places.c
+++ b/src/racket/src/places.c
@@ -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;
 }