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