tests/012/stack.tl


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
47
48
49
50

(load "../common")

(defvarl stack-limited (set-stack-limit 32768))

(defun recur () (recur))

(defmacro so (expr)
  ^(catch ,expr
     (stack-overflow (exc) :so)))

(test (so (recur)) :so)

(if (fboundp 'setrlimit)
  (test (let ((pid (fork)))
          (cond
            ((zerop pid)
             (set-stack-limit 0)
             (let ((rlim (getrlimit rlimit-stack)))
               (set rlim.cur 32768)
               (setrlimit rlimit-stack rlim))
             (recur))
            (t (let ((status (wait pid)))
                 (w-ifsignaled status)))))
        t))

(defmacro infexp ()
  ^(foo (infexp)))

(test (so (expand '(infexp))) :so)

(defvarl orig (get-stack-limit))

(mvtest
  (set-stack-limit nil) orig
  (set-stack-limit orig) nil
  (set-stack-limit 0) orig
  (set-stack-limit orig) nil
  (set-stack-limit 65536) orig
  (set-stack-limit orig) 65536)

(set-sig-handler sig-segv
  (lambda (signal async-p)
    (assert (null (get-stack-limit)))
    (throw 'out)))

(test
  (catch
    (raise sig-segv)
    (out () :sig))
  :sig)