test-stack-overflow 862 B

12345678910111213141516171819202122232425262728293031323334353637383940
  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 in stack space. That doesn't seem like
  8. ;; something we should run as part of an automated test suite.
  9. (exit 0))
  10. ;; 100 MB.
  11. (define *limit* (* 100 1024 1024))
  12. (call-with-values (lambda () (getrlimit 'as))
  13. (lambda (soft hard)
  14. (unless (and soft (< soft *limit*))
  15. (setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
  16. (define (test)
  17. (catch 'stack-overflow
  18. (lambda ()
  19. (let lp ()
  20. (lp)
  21. (error "should not be reached")))
  22. (lambda _
  23. #t)))
  24. ;; Run the test a few times. The stack will only be enlarged and
  25. ;; relocated on the first one.
  26. (test)
  27. (test)
  28. (test)
  29. (test)
  30. (test)
  31. ;; Local Variables:
  32. ;; mode: scheme
  33. ;; End: