euslisp/EusLisp — pull request #19 by snozawa (2014-05-09 09:42:32+00:00)
Title: Overwrite exit function

I create this PR from the following discussion:
https://github.com/jsk-ros-pkg/jsk_roseus/pull/21

- problem
exit code from unittest.l is not valid,
because all test codes using unittest.l end with "exit" like jskeus/irteus/test/*.l.
```
irteusgl
$ (require :unittest "lib/llib/unittest.l")
$ (init-unit-test)
$ (deftest test1 (assert nil))
$ (run-all-tests)
$ (exit)
$ echo $?
0 # <= this should not be 0!
```
- cause
This means unittest.l exit with 0 even if some test fails.
We need to checek "*unit-test*" failure in exit.

- solution
According to discussion with @k-okada, I tried *exit-hook* for this purpose,
but it did not work.

I tried to (1) find overwrite exit code, (2) set *exit-hook*, and (3) overwrite exit function.
This PR is (3).

-----------------------------------------------

1) overwrite exit code
I could not find the way to overwrite exit code other than exit function.

2) *exit-hook*
I write the following code in init-unit-test.l, but it does not work because of segfo.
```
(setq system:*exit-hook*
#'(lambda (&rest args)
(unix::_exit
(cond
((and args (/= (car args) 0)) ;; if exit code (/= 0) is specified
(car args))
((> (apply #'+ (send-all (send *unit-test* :result) :num-failures)) 0) ;; if test is failed
1)
(t 0) ;; if no exit code is specified and test is success, exit by 0
)
)))
```
Here is segfo message.
```
$ irteusgl
$ (require :unittest "lib/llib/unittest.l")
$ (init-unit-test)
$ (deftest test1 (assert t)) ;; successfull case
$ (run-all-tests)
$ (exit)
Program received signal SIGSEGV, Segmentation fault.
0x0000000000416b33 in getval (ctx=, sym=0x47c1860) at eval.c:56
56 else if (var->cix==vectorcp.cix) {
(gdb) bt
#0 0x0000000000416b33 in getval (ctx=, sym=0x47c1860)
at eval.c:56
#1 0x0000000000418d40 in funcode (ctx=0x7510b0, func=0x478f530,
args=0x4c52f08, noarg=) at eval.c:1011
#2 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c52f20,
fn=0x478ed80, args=0x4c52f08, env=0x0, noarg=-1) at eval.c:1116
#3 0x0000000000418d40 in funcode (ctx=0x7510b0, func=0x47a5f48,
args=0x4c52f50, noarg=) at eval.c:1011
#4 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c52f68,
fn=0x4759c50, args=0x4c52f50, env=0x0, noarg=-1) at eval.c:1116
#5 0x0000000000418d40 in funcode (ctx=0x7510b0, func=0x4793a38,
args=0x4c52f80, noarg=) at eval.c:1011
#6 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c52fb0,
fn=0x4793280, args=0x4c52f98, env=0x0, noarg=-1) at eval.c:1116
#7 0x0000000000418d40 in funcode (ctx=0x7510b0, func=0x478e720,
args=0x4c52fe0, noarg=) at eval.c:1011
#8 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c52ff8,
fn=0x478e000, args=0x4c52fe0, env=0x0, noarg=-1) at eval.c:1116
#9 0x000000000042b1ad in COND (ctx=0x7510b0, arg=0x4c53088) at specials.c:385
#10 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c530b8,
fn=0x4793690, args=0x4c530a0, env=0x0, noarg=-1) at eval.c:1116
#11 0x0000000000418d40 in funcode (ctx=0x7510b0, func=0x478a898,
args=0x4c530d0, noarg=) at eval.c:1011
#12 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c530e8,
fn=0x478a130, args=0x4c530d0, env=0x0, noarg=-1) at eval.c:1116
#13 0x0000000000417c9c in progn (ctx=0x7510b0, forms=0x4c53100) at eval.c:1231
#14 0x0000000000417ffe in funlambda (ctx=0x7510b0, fn=0x47a27c8,
formal=, body=0x4c53100, argp=,
env=, noarg=0) at eval.c:435
#15 0x0000000000418680 in ufuncall (ctx=0x7510b0, form=,
fn=0x47a27c8, args=0x7515a8, env=0x751640, noarg=0) at eval.c:1154
#16 0x0000000000447139 in EXIT (ctx=, n=0, argv=0x7515a8)
at unixcall.c:684
#17 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x4c50a18,
fn=0x47795e8, args=0x47a27c8, env=0x0, noarg=-1) at eval.c:1116
#18 0x00000000004bb636 in F69272rep1 (ctx=0x7510b0, n=,
argv=0x751558, env=) at toplevel.c:706
#19 0x00000000004bb9e4 in F69281repsel (ctx=0x7510b0, n=,
argv=0x751528, env=) at toplevel.c:900
#20 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x47cc978,
fn=0x47cf378, args=0x751528, env=0x0, noarg=4) at eval.c:1116
#21 0x000000000042c8b9 in APPLY (ctx=0x7510b0, n=,
argv=) at specials.c:105
#22 0x0000000000471f64 in M27439port_selector_select (ctx=0x7510b0,
n=, argv=0x7514d0, env=) at stream.c:3300
#23 0x000000000041ade0 in SEND (ctx=0x7510b0, n=3, argv=0x7514d0) at leo.c:296
#24 0x00000000004ba66d in F69284reploop_select (ctx=0x7510b0,
n=, argv=, env=)
at toplevel.c:1000
#25 0x00000000004bbf6d in F69287reploop (ctx=0x7510b0, n=,
argv=0x751410, env=) at toplevel.c:1089
#26 0x00000000004bcb4e in F69293eustop (ctx=0x7510b0, n=,
argv=, env=) at toplevel.c:1433
#27 0x00000000004189b1 in ufuncall (ctx=0x7510b0, form=0x47cc978,
fn=0x47cc978, args=0x751350, env=0x0, noarg=1) at eval.c:1116
#28 0x000000000044f4f1 in toplevel (ctx=0x7510b0, argc=1, argv=0x73e9a0)
at eus.c:1085
#29 0x00000000004516c3 in mainthread (ctx=0x7510b0) at eus.c:1236
#30 0x00000000004124dc in main (argc=, argv=)
at eus.c:1304
(gdb)
```
3) overwrite exit function
I tried to overwriting of exit function and it worked.
```
(defun exit (&optional (exit-code 0))
(unix::exit
(cond
((/= exit-code 0) ;; if exit code is not 0
exit-code)
((> (apply #'+ (send-all (send *unit-test* :result) :num-failures)) 0) ;; if exit code is set to 0 and test is failed
1)
(t 0) ;; if test is success, exit by 0
)
))
```