12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364 |
- 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))
- (catch
- ;; Silence GC warnings.
- (lambda ()
- (current-warning-port (open-output-file "/dev/null")))
- (lambda (k . args)
- (print-exception (current-error-port)
- (write "Skipping test.\n" (current-error-port))
- (exit 0)))
- ;; 50 MB.
- (define *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 _
-
- (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
- (test (lambda ()
- ;; This one is the kicker
- ;; can't expand. This is the hardest test to deal with because
- ;; the error-handling machinery has no memory in which to work.
- (iota
- (test (lambda ()
- ;; The same, but also causing allocating during the unwind
- ;; (ouch!)
- (dynamic-wind
- (lambda ()
- (lambda () (iota
- (lambda () (iota
- ;; Local Variables:
- ;; mode: scheme
- ;; End:
|