diff options
Diffstat (limited to 'tests/017')
-rw-r--r-- | tests/017/setjmp.expected | 4 | ||||
-rw-r--r-- | tests/017/setjmp.tl | 46 |
2 files changed, 50 insertions, 0 deletions
diff --git a/tests/017/setjmp.expected b/tests/017/setjmp.expected new file mode 100644 index 00000000..3d7a5493 --- /dev/null +++ b/tests/017/setjmp.expected @@ -0,0 +1,4 @@ +setjmp +result 42 +libpng longjmp +libpng error 42 diff --git a/tests/017/setjmp.tl b/tests/017/setjmp.tl new file mode 100644 index 00000000..6cb64b5a --- /dev/null +++ b/tests/017/setjmp.tl @@ -0,0 +1,46 @@ +;; 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 (dlopen "libpng.so")) + (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`)) |