test-out-of-memory 1.8 KB

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