1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
#lang zuo
(require "harness.zuo")
(alert "processes")
(define zuo.exe (hash-ref (runtime-env) 'exe))
(define answer.txt (build-path tmp-dir "answer.txt"))
;; check process without redirection, inculding multiple processes
(let ()
(define echo-to-file.zuo (build-path tmp-dir "echo-to-file.zuo"))
(let ([out (fd-open-output echo-to-file.zuo :truncate)])
(fd-write out (~a "#lang zuo\n"
(~s '(let* ([args (hash-ref (runtime-env) 'args)]
[out (fd-open-output (car args) :truncate)])
(fd-write out (cadr args))))))
(fd-close out))
(let ([ht (process zuo.exe
echo-to-file.zuo
(list answer.txt
"anybody home?"))])
(check (hash? ht))
(check (= 1 (hash-count ht)))
(check (handle? (hash-ref ht 'process)))
(let ([p (hash-ref ht 'process)])
(check (handle? p))
(check (process-wait p) p)
(check (process-wait p p p) p)
(check (handle? p))
(check (process-status p) 0))
(let ([in (fd-open-input answer.txt)])
(check (fd-read in eof) "anybody home?")
(fd-close in)))
(define answer2.txt (build-path tmp-dir "answer2.txt"))
(let ([ht1 (process zuo.exe echo-to-file.zuo answer.txt "one")]
[ht2 (process zuo.exe (list echo-to-file.zuo answer2.txt) "two")])
(define p1 (hash-ref ht1 'process))
(define p2 (hash-ref ht2 'process))
(define pa (process-wait p1 p2))
(define pb (process-wait (if (eq? p1 pa) p2 p1)))
(check (or (and (eq? p1 pa) (eq? p2 pb))
(and (eq? p1 pb) (eq? p2 pa))))
(check (process-status p1) 0)
(check (process-status p2) 0)
(check (process-wait p1) p1)
(check (process-wait p2) p2)
(define pc (process-wait p1 p2))
(check (or (eq? pc p1) (eq? pc p2)))
(let ([in (fd-open-input answer.txt)])
(check (fd-read in eof) "one")
(fd-close in))
(let ([in (fd-open-input answer2.txt)])
(check (fd-read in eof) "two")
(fd-close in))))
;; check setting the process directory and environment variables
(let ([path->absolute-path (lambda (p) (if (relative-path? p)
(build-path (hash-ref (runtime-env) 'dir) p)
p))])
(define runtime-to-file
(~a "#lang zuo\n"
(~s `(let* ([out (fd-open-output ,(path->absolute-path answer.txt) :truncate)])
(fd-write out (~s (cons
(hash-ref (runtime-env) 'dir)
(hash-ref (runtime-env) 'env))))))))
(let ([ht (process zuo.exe "" (hash 'stdin 'pipe))])
(check (hash? ht))
(check (= 2 (hash-count ht)))
(check (handle? (hash-ref ht 'process)))
(check (handle? (hash-ref ht 'stdin)))
(fd-write (hash-ref ht 'stdin) runtime-to-file)
(fd-close (hash-ref ht 'stdin))
(process-wait (hash-ref ht 'process))
(check (process-status (hash-ref ht 'process)) 0)
(let ()
(define in (fd-open-input answer.txt))
(define dir+env (car (string-read (fd-read in eof))))
(fd-close in)
(check (car dir+env) (hash-ref (runtime-env) 'dir))
(check (andmap (lambda (p)
(define p2 (assoc (car p) (cdr dir+env)))
(and p2 (equal? (cdr p) (cdr p2))))
(hash-ref (runtime-env) 'env)))))
(let* ([env (list (cons "HELLO" "there"))]
[ht (process zuo.exe "" (hash 'stdin 'pipe
'dir tmp-dir
'env env))])
(fd-write (hash-ref ht 'stdin) runtime-to-file)
(fd-close (hash-ref ht 'stdin))
(process-wait (hash-ref ht 'process))
(check (process-status (hash-ref ht 'process)) 0)
(let ()
(define in (fd-open-input answer.txt))
(define dir+env (car (string-read (fd-read in eof))))
(fd-close in)
(define (dir-identity d) (hash-ref (stat d #t) 'inode))
(check (dir-identity (car dir+env)) (dir-identity tmp-dir))
(check (andmap (lambda (p)
(define p2 (assoc (car p) (cdr dir+env)))
(and p2 (equal? (cdr p) (cdr p2))))
env)))))
;; make sure that the file descriptor for one process's pipe isn't
;; kept open by a second process
(let ()
(define ht1 (process zuo.exe "" (hash 'stdin 'pipe 'stdout 'pipe)))
(define ht2 (process zuo.exe "" (hash 'stdin 'pipe)))
(define in1 (hash-ref ht1 'stdin))
(fd-write in1 "#lang zuo 'hello")
(fd-close in1)
(check (fd-read (hash-ref ht1 'stdout) eof) "'hello\n")
(process-wait (hash-ref ht1 'process))
(fd-close (hash-ref ht1 'stdout))
(define in2 (hash-ref ht2 'stdin))
(fd-write in2 "#lang zuo")
(fd-close in2)
(process-wait (hash-ref ht2 'process))
(void))
;; check transfer of UTF-8 arguments and related
(define (check-process-arg arg)
(define p (process (hash-ref (runtime-env) 'exe)
""
arg
(hash 'stdin 'pipe 'stdout 'pipe)))
(define to (hash-ref p 'stdin))
(fd-write to "#lang zuo (displayln (hash-ref (runtime-env) 'args))")
(fd-close to)
(define from (hash-ref p 'stdout))
(define s (fd-read from eof))
(process-wait (hash-ref p 'process))
(check s (~a"(" arg ")\n")))
(check-process-arg "\316\273")
(check-process-arg "a b c")
(check-process-arg "a \"b\" c")
(check-process-arg "a \"b c")
(check-process-arg "a \\b c")
|
