mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
9687334ff5
On Darwin, setrlimit is ignored, and these tests do not terminate. There doesn't seem to be another way to limit the memory allocated by a process. * test-suite/standalone/test-stack-overflow: Skip this test on Darwin. * test-suite/standalone/test-out-of-memory: Skip this test on Darwin.
69 lines
2.1 KiB
Scheme
Executable file
69 lines
2.1 KiB
Scheme
Executable file
#!/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
|
|
|
|
(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:
|