Permalink
Browse files

some fixes for io, broken by the racket- prefixing

  • Loading branch information...
1 parent 45f97e4 commit 797ea24c7e2e929b8b99b934a29937da3f4e898a @awwx committed May 17, 2011
Showing with 50 additions and 22 deletions.
  1. +2 −2 ac.ss
  2. +5 −3 arc.arc
  3. +5 −0 io-test.ss
  4. +17 −17 io.arc
  5. +20 −0 io.t
  6. +1 −0 tests.sh
View
4 ac.ss
@@ -216,9 +216,9 @@
(body)))
-;; racket-module
+;; racket-module-ref
-(ac-def racket-module (a/module)
+(ac-def racket-module-ref (a/module)
(let ((r/module (deep-fromarc a/module)))
(lambda (sym)
(dynamic-require r/module sym))))
View
@@ -503,7 +503,7 @@
`',(eval x))
(def system (cmd)
- ((inline ((racket-module 'scheme/system) 'system)) cmd)
+ ((inline ((racket-module-ref 'scheme/system) 'system)) cmd)
nil)
(mac caselet (var expr . args)
@@ -522,6 +522,8 @@
(def try-custodian (port))
+(racket (racket-require (racket-prefix-in racket- scheme/tcp)))
+
(def close ports
(each port ports
(case (type port)
@@ -539,7 +541,7 @@
(racket (racket-open-output-file filename #:mode (racket-quote text) #:exists flag))))
(def open-socket (port)
- ((inline ((racket-module 'scheme/tcp) 'tcp-listen)) port 50 (racket "#t")))
+ ((inline ((racket-module-ref 'scheme/tcp) 'tcp-listen)) port 50 (racket "#t")))
(let expander
(fn (f var name body)
@@ -679,7 +681,7 @@
(map [do (write _) (disp " ")] args)
(disp #\newline))
-(def make-semaphore ((o init))
+(def make-semaphore ((o init 0))
(racket-make-semaphore init))
(def call-with-semaphore (sema func)
View
@@ -0,0 +1,5 @@
+#lang scheme
+
+(require "ac.ss")
+
+(aload (new-arc) "arc.arc" "io.arc" "equal-wrt-testing.arc" "test.arc" "io.t")
View
34 io.arc
@@ -9,32 +9,32 @@
;; Not worrying about how ugly this is right now on the assumption
;; that I'll be rewriting it in Arc anyway.
-(racket (require scheme/tcp))
-(racket (require scheme/port))
-(racket (require scheme/mpair))
-(racket (require (only-in "ar.ss" arc-list)))
+(racket (racket-require (racket-prefix-in racket- scheme/tcp)))
+(racket (racket-require (racket-prefix-in racket- scheme/port)))
+(racket (racket-require (racket-prefix-in racket- scheme/mpair)))
+(racket (racket-require (racket-only-in "ar.ss" arc-list)))
(def socket-accept (s)
(let associate-custodian associate-custodian
(racket "
- (let ((oc (current-custodian))
- (nc (make-custodian)))
- (current-custodian nc)
- (call-with-values
- (lambda () (tcp-accept s))
- (lambda (in out)
- (let ((in1 (make-limited-input-port in 100000 #t)))
- (current-custodian oc)
+ (racket-let ((oc (racket-current-custodian))
+ (nc (racket-make-custodian)))
+ (racket-current-custodian nc)
+ (racket-call-with-values
+ (racket-lambda () (racket-tcp-accept s))
+ (racket-lambda (in out)
+ (racket-let ((in1 (racket-make-limited-input-port in 100000 #t)))
+ (racket-current-custodian oc)
(associate-custodian nc in1 out)
(arc-list in1
out
- (let-values (((us them) (tcp-addresses out)))
+ (racket-let-values (((us them) (racket-tcp-addresses out)))
them))))))
")))
;; breaks the compiler to require foreign.ss into our namespace
-(racket (module setuid scheme
+(racket (racket-module setuid scheme
(require (lib "foreign.ss"))
(unsafe!)
(provide setuid)
@@ -43,7 +43,7 @@
;; And this *is* ugly... but it has the advantage that it works.
(def setuid (uid)
- ((inline ((racket-module ''setuid) 'setuid)) uid))
+ ((inline ((racket-module-ref ''setuid) 'setuid)) uid))
(def dir (name)
(ar-toarc (racket (map path->string (directory-list name)))))
@@ -57,11 +57,11 @@
y)))
(def dead (thd)
- (aracket-true (racket.thread-dead? thd)))
+ (aracket-true (racket-thread-dead? thd)))
(def try-custodian (port)
(whenlet custodian (custodians* port)
- (racket.custodian-shutdown-all custodian)
+ (racket-custodian-shutdown-all custodian)
(wipe (custodians* port))
t))
View
20 io.t
@@ -0,0 +1,20 @@
+(= tcp-test-port* 50013)
+
+(def tcp-connect (host port)
+ (racket "(racket-let-values (((i o) (racket-tcp-connect host port)))
+ (arc-list i o))"))
+
+(let ready (make-semaphore)
+
+ (thread
+ (w/socket s tcp-test-port*
+ (racket-semaphore-post ready)
+ (let (i o ip) (socket-accept s)
+ (disp "foo" o)
+ (racket-flush-output o)
+ (close i o))))
+
+ (racket-semaphore-wait ready)
+ (testis (let (i o) (tcp-connect "127.0.0.1" tcp-test-port*)
+ (string (n-of 3 (readc i))))
+ "foo"))
View
@@ -3,4 +3,5 @@ set -e -v
racket ar-test.ss
racket ac-test.ss
racket arc-test.ss
+racket io-test.ss
racket strings-test.ss

0 comments on commit 797ea24

Please sign in to comment.