summaryrefslogtreecommitdiff
path: root/gnu/tests.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests.scm')
-rw-r--r--gnu/tests.scm122
1 files changed, 61 insertions, 61 deletions
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 1821ac45c55..8abe6c608ba 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -80,68 +80,68 @@
80 (srfi srfi-9 gnu) 80 (srfi srfi-9 gnu)
81 (guix build syscalls) 81 (guix build syscalls)
82 (rnrs bytevectors))) 82 (rnrs bytevectors)))
83 (imported-modules `((guix build syscalls)
84 ,@imported-modules))
85 (start 83 (start
86 #~(lambda () 84 (with-imported-modules `((guix build syscalls)
87 (define (clear-echo termios) 85 ,@imported-modules)
88 (set-field termios (termios-local-flags) 86 #~(lambda ()
89 (logand (lognot (local-flags ECHO)) 87 (define (clear-echo termios)
90 (termios-local-flags termios)))) 88 (set-field termios (termios-local-flags)
91 89 (logand (lognot (local-flags ECHO))
92 (define (self-quoting? x) 90 (termios-local-flags termios))))
93 (letrec-syntax ((one-of (syntax-rules () 91
94 ((_) #f) 92 (define (self-quoting? x)
95 ((_ pred rest ...) 93 (letrec-syntax ((one-of (syntax-rules ()
96 (or (pred x) 94 ((_) #f)
97 (one-of rest ...)))))) 95 ((_ pred rest ...)
98 (one-of symbol? string? pair? null? vector? 96 (or (pred x)
99 bytevector? number? boolean?))) 97 (one-of rest ...))))))
100 98 (one-of symbol? string? pair? null? vector?
101 (match (primitive-fork) 99 bytevector? number? boolean?)))
102 (0 100
103 (dynamic-wind 101 (match (primitive-fork)
104 (const #t) 102 (0
105 (lambda () 103 (dynamic-wind
106 (let* ((repl (open-file #$device "r+0")) 104 (const #t)
107 (termios (tcgetattr (fileno repl))) 105 (lambda ()
108 (console (open-file "/dev/console" "r+0"))) 106 (let* ((repl (open-file #$device "r+0"))
109 ;; Don't echo input back. 107 (termios (tcgetattr (fileno repl)))
110 (tcsetattr (fileno repl) (tcsetattr-action TCSANOW) 108 (console (open-file "/dev/console" "r+0")))
111 (clear-echo termios)) 109 ;; Don't echo input back.
112 110 (tcsetattr (fileno repl) (tcsetattr-action TCSANOW)
113 ;; Redirect output to the console. 111 (clear-echo termios))
114 (close-fdes 1) 112
115 (close-fdes 2) 113 ;; Redirect output to the console.
116 (dup2 (fileno console) 1) 114 (close-fdes 1)
117 (dup2 (fileno console) 2) 115 (close-fdes 2)
118 (close-port console) 116 (dup2 (fileno console) 1)
119 117 (dup2 (fileno console) 2)
120 (display 'ready repl) 118 (close-port console)
121 (let loop () 119
122 (newline repl) 120 (display 'ready repl)
123 121 (let loop ()
124 (match (read repl) 122 (newline repl)
125 ((? eof-object?) 123
126 (primitive-exit 0)) 124 (match (read repl)
127 (expr 125 ((? eof-object?)
128 (catch #t 126 (primitive-exit 0))
129 (lambda () 127 (expr
130 (let ((result (primitive-eval expr))) 128 (catch #t
131 (write (if (self-quoting? result) 129 (lambda ()
132 result 130 (let ((result (primitive-eval expr)))
133 (object->string result)) 131 (write (if (self-quoting? result)
134 repl))) 132 result
135 (lambda (key . args) 133 (object->string result))
136 (print-exception (current-error-port) 134 repl)))
137 (stack-ref (make-stack #t) 1) 135 (lambda (key . args)
138 key args) 136 (print-exception (current-error-port)
139 (write #f repl))))) 137 (stack-ref (make-stack #t) 1)
140 (loop)))) 138 key args)
141 (lambda () 139 (write #f repl)))))
142 (primitive-exit 1)))) 140 (loop))))
143 (pid 141 (lambda ()
144 pid)))) 142 (primitive-exit 1))))
143 (pid
144 pid)))))
145 (stop #~(make-kill-destructor))))))) 145 (stop #~(make-kill-destructor)))))))
146 146
147(define marionette-service-type 147(define marionette-service-type