test-suite/standalone/test-out-of-memory

   1 #!/bin/sh
   2 guild compile "$0"
   3 exec guile -q -s "$0" "$@"
   4 !#
   5
   6 (unless (defined? 'setrlimit)
   7   ;; Without an rlimit, this test can take down your system, as it
   8   ;; consumes all of your memory.  That doesn't seem like something we
   9   ;; should run as part of an automated test suite.
  10   (exit 0))
  11
  12 (catch #t
  13   ;; Silence GC warnings.
  14   (lambda ()
  15     (current-warning-port (open-output-file "/dev/null")))
  16   (lambda (k . args)
  17     (print-exception (current-error-port) #f k args)
  18     (write "Skipping test.\n" (current-error-port))
  19     (exit 0)))
  20
  21 ;; 50 MB.
  22 (define *limit* (* 50 1024 1024))
  23
  24 (call-with-values (lambda () (getrlimit 'as))
  25   (lambda (soft hard)
  26     (unless (and soft (< soft *limit*))
  27       (setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
  28
  29 (define (test thunk)
  30   (catch 'out-of-memory
  31     (lambda ()
  32       (thunk)
  33       (error "should not be reached"))
  34     (lambda _
  35       #t)))
  36
  37 (use-modules (rnrs bytevectors))
  38
  39 (test (lambda ()
  40         ;; Unhappily, on 32-bit systems, vectors are limited to 16M
  41         ;; elements.  Boo.  Anyway, a vector with 16M elements takes 64
  42         ;; MB, which doesn't fit into 50 MB.
  43         (make-vector (1- (ash 1 24)))))
  44 (test (lambda ()
  45         ;; Likewise for a bytevector.  This is different from the above,
  46         ;; as the elements of a bytevector are not traced by GC.
  47         (make-bytevector #e1e9)))
  48 (test (lambda ()
  49         ;; This one is the kicker -- we allocate pairs until the heap
  50         ;; can't expand.  This is the hardest test to deal with because
  51         ;; the error-handling machinery has no memory in which to work.
  52         (iota #e1e8)))
  53 (test (lambda ()
  54         ;; The same, but also causing allocating during the unwind
  55         ;; (ouch!)
  56         (dynamic-wind
  57           (lambda () #t)
  58           (lambda () (iota #e1e8))
  59           (lambda () (iota #e1e8)))))
  60
  61 ;; Local Variables:
  62 ;; mode: scheme
  63 ;; End: