blob: 3a1653a97ee97685d1335f7181ea609892300cc7 (
plain)
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
|
;;;; sandbox.test --- tests guile's evaluator -*- scheme -*-
;;;; Copyright (C) 2017 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite sandbox)
#:use-module (test-suite lib)
#:use-module (ice-9 sandbox))
(define exception:bad-expression
(cons 'syntax-error "Bad expression"))
(define exception:failed-match
(cons 'syntax-error "failed to match any pattern"))
(define exception:not-a-list
(cons 'wrong-type-arg "Not a list"))
(define exception:wrong-length
(cons 'wrong-type-arg "wrong length"))
(define (usleep-loop usecs)
(unless (zero? usecs)
(usleep-loop (usleep usecs))))
(define (busy-loop)
(busy-loop))
(with-test-prefix "time limit"
(pass-if "0 busy loop"
(call-with-time-limit 0 busy-loop (lambda () #t)))
(pass-if "0.001 busy loop"
(call-with-time-limit 0.001 busy-loop (lambda () #t)))
(pass-if "0 sleep"
(call-with-time-limit 0 (lambda () (usleep-loop #e1e6) #f)
(lambda () #t)))
(pass-if "0.001 sleep"
(call-with-time-limit 0.001 (lambda () (usleep-loop #e1e6) #f)
(lambda () #t))))
(define (alloc-loop)
(let lp ((ret #t))
(and ret
(lp (cons #t #t)))))
(define (recur-loop)
(1+ (recur-loop)))
(with-test-prefix "allocation limit"
(pass-if "0 alloc loop"
(call-with-allocation-limit 0 alloc-loop (lambda () #t)))
(pass-if "1e6 alloc loop"
(call-with-allocation-limit #e1e6 alloc-loop (lambda () #t)))
(pass-if "0 recurse"
(call-with-allocation-limit 0 recur-loop (lambda () #t)))
(pass-if "1e6 recurse"
(call-with-allocation-limit #e1e6 recur-loop (lambda () #t))))
(define-syntax-rule (pass-if-unbound foo)
(pass-if-exception (format #f "~a unavailable" 'foo)
exception:unbound-var (eval-in-sandbox 'foo))
)
(with-test-prefix "eval-in-sandbox"
(pass-if-equal 42
(eval-in-sandbox 42))
(pass-if-equal 'foo
(eval-in-sandbox ''foo))
(pass-if-equal '(1 . 2)
(eval-in-sandbox '(cons 1 2)))
(pass-if-unbound @@)
(pass-if-unbound foo)
(pass-if-unbound set!)
(pass-if-unbound open-file)
(pass-if-unbound current-input-port)
(pass-if-unbound call-with-output-file)
(pass-if-unbound vector-set!)
(pass-if-equal vector-set!
(eval-in-sandbox 'vector-set!
#:bindings all-pure-and-impure-bindings))
(pass-if-exception "limit exceeded"
'(limit-exceeded . "")
(eval-in-sandbox '(let lp () (lp)))))
|
