blob: dd54249d8d842ee689951dbb97daa46ab9f17e3f (
about) (
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
|
#!/bin/sh
guild compile "$0"
exec guile -q -s "$0" "$@"
!#
(unless (defined? 'setrlimit)
;; Without an rlimit, this test can take down your system, as it
;; consumes all of your memory in stack space. That doesn't seem like
;; something we should run as part of an automated test suite.
(exit 0))
(when (string-ci= "darwin" (vector-ref (uname) 0))
;; setrlimits are ignored in OS X (tested on 10.9 and 10.10). Proceeding
;; with the test would fill all available memory and probably end in a crash.
;; See also test-out-of-memory.
(exit 77)) ; uresolved
(when (string-ci= "GNU" (vector-ref (uname) 0))
;; setrlimits are not yet implemented on GNU/Hurd systems. Proceeding
;; with the test would end in a crash. See
;; <https://lists.gnu.org/archive/html/bug-hurd/2017-05/msg00013.html>
(exit 77)) ; unresolved
(when (string-contains-ci (vector-ref (uname) 0) "CYGWIN_NT")
;; attempting to use setrlimits for memory RLIMIT_AS will always
;; produce an invalid argument error on Cygwin (tested on
;; CYGWIN_NT-10.0 DLL v2.7.0). Proceeding with the test would fill
;; all available memory and probably end in a crash. See also
;; test-out-of-memory.
(exit 77)) ; unresolved
;; 100 MB.
(define *limit* (* 100 1024 1024))
(call-with-values (lambda () (getrlimit 'as))
(lambda (soft hard)
(unless (and soft (< soft *limit*))
(setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
(define (test)
(catch 'stack-overflow
(lambda ()
(let lp ()
(lp)
(error "should not be reached")))
(lambda _
#t)))
;; Run the test a few times. The stack will only be enlarged and
;; relocated on the first one.
(test)
(test)
(test)
(test)
(test)
;; Local Variables:
;; mode: scheme
;; End:
|
