Commit | Line | Data |
---|---|---|
c2247b78 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. That doesn't seem like something we | |
8 | ;; should run as part of an automated test suite. | |
9 | (exit 0)) | |
10 | ||
11 | (catch #t | |
12 | ;; Silence GC warnings. | |
13 | (lambda () | |
14 | (current-warning-port (open-output-file "/dev/null"))) | |
15 | (lambda (k . args) | |
16 | (print-exception (current-error-port) #f k args) | |
17 | (write "Skipping test.\n" (current-error-port)) | |
18 | (exit 0))) | |
19 | ||
20 | ;; 100 MB. | |
21 | (define *limit* (* 100 1024 1024)) | |
22 | ||
23 | (call-with-values (lambda () (getrlimit 'as)) | |
24 | (lambda (soft hard) | |
25 | (unless (and soft (< soft *limit*)) | |
26 | (setrlimit 'as (if hard (min *limit* hard) *limit*) hard)))) | |
27 | ||
28 | (define (test thunk) | |
29 | (catch 'out-of-memory | |
30 | (lambda () | |
31 | (thunk) | |
32 | (error "should not be reached")) | |
33 | (lambda _ | |
34 | #t))) | |
35 | ||
36 | (use-modules (rnrs bytevectors)) | |
37 | ||
38 | (test (lambda () | |
39 | ;; A vector with a billion elements doesn't fit into 100 MB. | |
40 | (make-vector #e1e9))) | |
41 | (test (lambda () | |
42 | ;; Likewise for a bytevector. This is different from the above, | |
43 | ;; as the elements of a bytevector are not traced by GC. | |
44 | (make-bytevector #e1e9))) | |
45 | (test (lambda () | |
46 | ;; This one is the kicker -- we allocate pairs until the heap | |
47 | ;; can't expand. This is the hardest test to deal with because | |
48 | ;; the error-handling machinery has no memory in which to work. | |
49 | (iota #e1e8))) | |
50 | (test (lambda () | |
51 | ;; The same, but also causing allocating during the unwind | |
52 | ;; (ouch!) | |
53 | (dynamic-wind | |
54 | (lambda () #t) | |
55 | (lambda () (iota #e1e8)) | |
56 | (lambda () (iota #e1e8))))) | |
57 | ||
58 | ;; Local Variables: | |
59 | ;; mode: scheme | |
60 | ;; End: |