diff options
Diffstat (limited to 'test-suite/standalone/test-out-of-memory')
-rwxr-xr-x | test-suite/standalone/test-out-of-memory | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/test-suite/standalone/test-out-of-memory b/test-suite/standalone/test-out-of-memory new file mode 100755 index 000000000..221651270 --- /dev/null +++ b/test-suite/standalone/test-out-of-memory @@ -0,0 +1,83 @@ +#!/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. 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-stack-overflow. + (exit 77)) ; unresolved + +(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-stack-overflow. + (exit 77)) ; unresolved + +(catch #t + ;; Silence GC warnings. + (lambda () + (current-warning-port (open-output-file "/dev/null"))) + (lambda (k . args) + (print-exception (current-error-port) #f k args) + (write "Skipping test.\n" (current-error-port)) + (exit 0))) + +;; 50 MB. +(define *limit* (* 50 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 thunk) + (catch 'out-of-memory + (lambda () + (thunk) + (error "should not be reached")) + (lambda _ + #t))) + +(use-modules (rnrs bytevectors)) + +(test (lambda () + ;; Unhappily, on 32-bit systems, vectors are limited to 16M + ;; elements. Boo. Anyway, a vector with 16M elements takes 64 + ;; MB, which doesn't fit into 50 MB. + (make-vector (1- (ash 1 24))))) +(test (lambda () + ;; Likewise for a bytevector. This is different from the above, + ;; as the elements of a bytevector are not traced by GC. + (make-bytevector #e1e9))) +(test (lambda () + ;; This one is the kicker -- we allocate pairs until the heap + ;; can't expand. This is the hardest test to deal with because + ;; the error-handling machinery has no memory in which to work. + (iota #e1e8))) +(test (lambda () + ;; The same, but also causing allocating during the unwind + ;; (ouch!) + (dynamic-wind + (lambda () #t) + (lambda () (iota #e1e8)) + (lambda () (iota #e1e8))))) + +;; Local Variables: +;; mode: scheme +;; End: |