summaryrefslogtreecommitdiff
path: root/test-suite/standalone/test-out-of-memory
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/standalone/test-out-of-memory')
-rwxr-xr-xtest-suite/standalone/test-out-of-memory83
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: