summaryrefslogtreecommitdiff
path: root/test-suite/standalone/test-stack-overflow
blob: 74bc7b874eba88c18bd7ac862d83e4c80e201555 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#!/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 in stack space.  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)) ; uresolved

;; 100 MB.
(define *limit* (* 100 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)
  (catch 'stack-overflow
    (lambda ()
      (let lp ()
        (lp)
        (error "should not be reached")))
    (lambda _
      #t)))

;; Run the test a few times.  The stack will only be enlarged and
;; relocated on the first one.

(test)
(test)
(test)
(test)
(test)

;; Local Variables:
;; mode: scheme
;; End: