tests/017/setjmp.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

;; test local setjmp
(let ((jb (jmp-buf)))
  (setjmp jb result
    (progn (put-line "setjmp")
           (longjmp jb 42))
    (put-line `result @result`)))

(defun png-fake-output ()
  (put-string "libpng longjmp\nlibpng error 42\n")
  (exit))

(unless (ignerr (let ((png (dlopen "libpng.so")))
                  (nequal cptr-null (dlsym png "png_set_longjmp_fn"))))
  (png-fake-output))

;; needed by png-set-longjmp-fn API
(defvarl libc (dlopen nil))
(defvarl longjmp-addr (dlsym libc "longjmp"))

(typedef png-structp (cptr png))

(with-dyn-lib "libpng.so"
  (deffi png-get-header-ver "png_get_header_ver" str (png-structp))
  (deffi png-create-read-struct "png_create_read_struct" png-structp (str cptr cptr cptr))
  (deffi png-set-longjmp-fn "png_set_longjmp_fn" (carray uchar) (png-structp (cptr dlsym) size-t))
  (deffi png-longjmp "png_longjmp" void (png-structp int)))

(defvar png-ver (png-get-header-ver cptr-null))

;; In the png.h header, png_setjmp is a macro only; you cannot
;; #undef it to get to a function. So we write the macro in
;; the same way as a Lisp macro, in terms of png-set-longjmp-fn,
;; whereby we pass the longjmp function, and sizeof (jmp_buf).
(defmacro png-setjmp (png-ptr)
  (let ((jmpbuf-size (load-time (len (jmp-buf)))))
    ^(png-set-longjmp-fn ,png-ptr longjmp-addr ,jmpbuf-size)))

;;; Test

;; get png handle
(defvar png (png-create-read-struct png-ver cptr-null cptr-null cptr-null))

;; get jmp_buf from png handle, setjmp it, longjmp to it.
(setjmp (png-setjmp png) err
  (progn (put-line "libpng longjmp")
         (png-longjmp png 42))
  (put-line `libpng error @err`))