Commit | Line | Data |
---|---|---|
4189a5c0 AW |
1 | #!/bin/sh |
2 | exec guile -q -s "$0" "$@" | |
3 | !# | |
4 | ||
5 | (unless (defined? 'setrlimit) | |
6 | ;; Without an rlimit, this test can take down your system, as it | |
7 | ;; consumes all of your memory in stack space. That doesn't seem like | |
8 | ;; something we should run as part of an automated test suite. | |
9 | (exit 0)) | |
10 | ||
11 | ;; 100 MB. | |
12 | (define *limit* (* 100 1024 1024)) | |
13 | ||
14 | (call-with-values (lambda () (getrlimit 'as)) | |
15 | (lambda (soft hard) | |
16 | (unless (and soft (< soft *limit*)) | |
17 | (setrlimit 'as (if hard (min *limit* hard) *limit*) hard)))) | |
18 | ||
19 | (define (test) | |
20 | (catch 'stack-overflow | |
21 | (lambda () | |
22 | (let lp () | |
23 | (lp) | |
24 | (error "should not be reached"))) | |
25 | (lambda _ | |
26 | #t))) | |
27 | ||
28 | ;; Run the test a few times. The stack will only be enlarged and | |
29 | ;; relocated on the first one. | |
30 | (test) | |
31 | (test) | |
32 | (test) | |
33 | (test) | |
34 | (test) | |
35 | ||
36 | ;; Local Variables: | |
37 | ;; mode: scheme | |
38 | ;; End: |