Skip to content

Commit

Permalink
Merge pull request #432 from k-okada/fix_intersection3_entry2
Browse files Browse the repository at this point in the history
add tests that fails in armhf
  • Loading branch information
k-okada committed May 25, 2020
2 parents 40051e5 + 218ba0f commit 21a5d86
Show file tree
Hide file tree
Showing 10 changed files with 129 additions and 17 deletions.
29 changes: 23 additions & 6 deletions .travis.sh
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,23 @@ if [ "$QEMU" != "" ]; then
travis_time_end `expr 32 - $TMP_EXIT_STATUS`

export EXIT_STATUS=`expr $TMP_EXIT_STATUS + $EXIT_STATUS`;

travis_time_start compiled.${test_l##*/}.test

eusgl "(let ((o (namestring (merge-pathnames \".o\" \"$test_l\"))) (so (namestring (merge-pathnames \".so\" \"$test_l\")))) (compile-file \"$test_l\" :o o) (if (probe-file so) (load so) (exit 1))))"
export TMP_EXIT_STATUS=$?

export CONTINUE=0
# const.l does not compilable https://github.com/euslisp/EusLisp/issues/318
if [[ $test_l =~ const.l ]]; then export CONTINUE=1; fi

if [[ $CONTINUE == 0 ]]; then travis_time_end `expr 32 - $TMP_EXIT_STATUS`; else travis_time_end 33; fi

if [[ $TMP_EXIT_STATUS != 0 ]]; then echo "Failed running $test_l. Exiting with $TMP_EXIT_STATUS"; fi

if [[ $CONTINUE != 0 ]]; then continue; fi

export EXIT_STATUS=`expr $TMP_EXIT_STATUS + $EXIT_STATUS`;
done;
echo "Exit status : $EXIT_STATUS";

Expand Down Expand Up @@ -129,8 +146,14 @@ if [[ "$DOCKER_IMAGE" == *"trusty"* || "$DOCKER_IMAGE" == *"jessie"* ]]; then
else
make eus-installed WFLAGS="-Werror=implicit-int -Werror=implicit-function-declaration -Werror=incompatible-pointer-types -Werror=int-conversion -Werror=unused-result"
fi
travis_time_end

travis_time_start script.make.jskeus

make

travis_time_end

travis_time_start script.eustag

(cd eus/lisp/tool; make)
Expand Down Expand Up @@ -237,10 +260,6 @@ fi
export TMP_EXIT_STATUS=$?

export CONTINUE=0
# bignum test fails on armhf
if [[ "`uname -m`" == "arm"* && $test_l =~ bignum.l ]]; then export CONTINUE=1; fi
# sort test fails on armhf (https://github.com/euslisp/EusLisp/issues/232)
if [[ "`uname -m`" == "arm"* && $test_l =~ sort.l ]]; then export CONTINUE=1; fi
# const.l does not compilable https://github.com/euslisp/EusLisp/issues/318
if [[ $test_l =~ const.l ]]; then export CONTINUE=1; fi

Expand All @@ -263,8 +282,6 @@ fi
export TMP_EXIT_STATUS=$?

export CONTINUE=0
# irteus-demo.l, robot-model-usage.l and test-irt-motion.l fails on armhf both trusty and xenial
if [[ "`uname -m`" == "arm"* && $test_l =~ irteus-demo.l|robot-model-usage.l|test-irt-motion.l ]]; then export CONTINUE=1; fi
# skip collision test because bullet of 2.83 or later version is not released in trusty and jessie.
# https://github.com/euslisp/jskeus/blob/6cb08aa6c66fa8759591de25b7da68baf76d5f09/irteus/Makefile#L37
if [[ ( "$DOCKER_IMAGE" == *"trusty"* || "$DOCKER_IMAGE" == *"jessie"* ) && $test_l =~ test-collision.l ]]; then export CONTINUE=1; fi
Expand Down
2 changes: 0 additions & 2 deletions lisp/Makefile.LinuxARM
Original file line number Diff line number Diff line change
Expand Up @@ -46,11 +46,9 @@ ifeq ($(GCC_MAJOR_VERSION), 2)
ADD_CFLAGS=-fno-stack-protector -fpic
else
ifeq ($(MACHINE), aarch64)
CPU_OPTIMIZE=-march=armv8-a
ALIGN_FUNCTIONS=-falign-functions=8
ADD_CFLAGS=-fPIC -Darmv8
else
CPU_OPTIMIZE=-march=$(MACHINE)
ALIGN_FUNCTIONS=-falign-functions=4
ADD_CFLAGS=-fno-stack-protector -fpic
endif
Expand Down
1 change: 1 addition & 0 deletions lisp/c/big.c
Original file line number Diff line number Diff line change
Expand Up @@ -364,6 +364,7 @@ eusinteger_t i;
for (j=0; j<vlen; j++) newv->c.ivec.iv[j]=bn->c.ivec.iv[j];
newv->c.ivec.iv[vlen]=i;
pointer_update(x->c.bgnm.bv, newv);
x->c.bgnm.size=makeint(vlen+1);
return(newv);
}

Expand Down
2 changes: 2 additions & 0 deletions lisp/c/eus.h
Original file line number Diff line number Diff line change
Expand Up @@ -737,6 +737,7 @@ extern int export_all;
#define isint(p) (!((eusinteger_t)(p) & 3))
#define isflt(p) (((eusinteger_t)(p) & 3)==1)
#define isnum(p) (((eusinteger_t)(p) & 2)==0)
#define numberp(p) (((isnum(p)) || (pisextnum(p)))) // predicates.c:NUMBERP
#define ispointer(p) ((eusinteger_t)(p) & 2)
#define makeint(v) ((pointer)(((eusinteger_t)v)<<2))
#define bpointerof(p) ((bpointer)((eusinteger_t)(p)-2))
Expand All @@ -749,6 +750,7 @@ extern int export_all;
#define isint(p) ( (((eusinteger_t)(p)&3)==2) || (((eusinteger_t)(p)&0x3)==0x3) )
#define isflt(p) (((eusinteger_t)(p) & 3)==1)
#define isnum(p) (((eusinteger_t)(p) & 3))
#define numberp(p) (((isnum(p)) || (pisextnum(p)))) // predicates.c:NUMBERP
#define ispointer(p) (!((eusinteger_t)(p) & 3))
// #define makeint(v) ((pointer)((((eusinteger_t)(v))<<2)+2)) // org
#ifdef __cplusplus
Expand Down
8 changes: 4 additions & 4 deletions lisp/c/loadelf.c
Original file line number Diff line number Diff line change
Expand Up @@ -113,7 +113,7 @@ register context *ctx;
addr= addr>>2;
mod->c.ldmod.entry=makeint(addr);
#if ARM
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
#endif
mod->c.ldmod.subrtype=SUBR_ENTRY;
(*initfunc)(ctx,1, &mod); }
Expand Down Expand Up @@ -180,7 +180,7 @@ pointer initnames;
mod->c.ldmod.codevec=makeint(0);
mod->c.ldmod.entry=makeint(addr);
#if ARM
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
#endif
mod->c.ldmod.subrtype=SUBR_FUNCTION;
p=cons(ctx,mod, NIL);
Expand Down Expand Up @@ -231,7 +231,7 @@ pointer *argv;
mod->c.ldmod.codevec=makeint(0);
mod->c.ldmod.entry=makeint(addr);
#if ARM
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
#endif
mod->c.ldmod.subrtype=SUBR_FUNCTION;
p=cons(ctx,mod, NIL);
Expand Down Expand Up @@ -409,7 +409,7 @@ pointer *argv;
mod->c.ldmod.codevec=makeint(0);
mod->c.ldmod.entry=makeint(addr);
#if ARM
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
#endif
mod->c.ldmod.subrtype=SUBR_FUNCTION;
(*initfunc)(ctx, 1, &mod); }
Expand Down
4 changes: 2 additions & 2 deletions lisp/c/makes.c
Original file line number Diff line number Diff line change
Expand Up @@ -292,7 +292,7 @@ pointer (*f)();
fentaddr= (eusinteger_t)f>>2;
cd->c.code.entry=makeint(fentaddr);
#if ARM
cd->c.code.entry2=makeint((eusinteger_t)f);
cd->c.code.entry2=makeint(((eusinteger_t)f)&0x3);
#endif
return(cd);}

Expand Down Expand Up @@ -513,7 +513,7 @@ pointer (*f)();
clo->c.clo.subrtype=SUBR_FUNCTION;
clo->c.clo.entry=makeint((eusinteger_t)f>>2);
#if ARM
clo->c.clo.entry2=makeint((eusinteger_t)f);
clo->c.clo.entry2=makeint(((eusinteger_t)f)&0x3);
#endif
clo->c.clo.env0=e0;
clo->c.clo.env1=e1; /*makeint((int)e1>>2);*/
Expand Down
4 changes: 2 additions & 2 deletions lisp/comp/trans.l
Original file line number Diff line number Diff line change
Expand Up @@ -438,7 +438,7 @@
(send self :push
(format nil "(~A(w)?T:NIL)"
(cdr (assoc pred '((symbolp . "issymbol") (consp . "iscons")
(numberp . "isnum") (integerp . "isint")
(numberp . "numberp") (integerp . "isint")
(floatp . "isflt") (stringp . "isstring")
))))))
(:if-nil (lab)
Expand Down Expand Up @@ -511,7 +511,7 @@
;;; type check
(:type-checker (tn)
(cdr (assq tn '((symbolp . "issymbol") (integerp . "isint")
(numberp . "isnum")
(numberp . "numberp")
(floatp . "isflt") (atom . "!iscons")
(consp . "iscons") (stringp . "isstring")))))
(:if-type (type lab)
Expand Down
4 changes: 3 additions & 1 deletion lisp/geo/intersection.c
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,7 @@ register pointer argv[];
eusfloat_t cz,u,v;
eusfloat_t *p1, v1[3], *p2, v2[3], p2p1[3];
eusfloat_t cross[3], cross2;
pointer up,vp;
numunion nu;

ckarg2(4,5);
Expand All @@ -115,7 +116,8 @@ register pointer argv[];

u=determinant3(p2p1,v2,cross)/cross2;
v=determinant3(p2p1,v1,cross)/cross2;
return(cons(ctx,makeflt(u),cons(ctx,makeflt(v),NIL))); }
up=makeflt(u); vp=makeflt(v);
return(cons(ctx,up,cons(ctx,vp,NIL))); }


/*
Expand Down
74 changes: 74 additions & 0 deletions test/env.l
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
(require :unittest "lib/llib/unittest.l")

(init-unit-test)

(eval-when (compile) ;; this does not work on compiled code
(when nil

;;(defun make-c (a) (let ((x 0)) #'(lambda () (list a x))))
;;(defun make-c () (let ((x 0)) #'(lambda () (list x))))
(defun make-c0 () #'(lambda () (list 0)))

(compile 'make-c0)
(setq f0 (make-c0))

(deftest f0
(format t ";; funcall make-c0 ~A~%" (funcall f0))
(assert (equal (funcall f0) '(0))))

(defun make-c1 () (let () #'(lambda (x) (list x))))

(compile 'make-c1)
(setq f1 (make-c1))

(deftest f1
(format t ";; funcall make-c1 ~A~%" (funcall f1 1))
(assert (equal (funcall f1 1) '(1))))

(defun make-c2 () (let ((x 0)) #'(lambda () (list x))))

(compile 'make-c2)
(setq f2 (make-c2))

(deftest f2
(format t ";; funcall make-c2 ~A~%" (funcall f2))
(assert (equal (funcall f2) '(0))))

(setq *x* 2) (defun make-c3 () #'(lambda () (list *x*)))

(compile 'make-c3)
(setq f3 (make-c3))

(deftest f3
(format t ";; funcall make-c3 ~A~%" (funcall f3))
(assert (equal (funcall f3) '(2))))

(defun make-c4 () #'(lambda (x) (list x)))

(compile 'make-c4)
(setq f4 (make-c4))

(deftest f4
(format t ";; funcall make-c4 ~A~%" (funcall f4 1))
(assert (equal (funcall f4 1) '(1))))

)) ;; eval-when (compile) (when nil

(deftest lambda-in-lambda
(let (r)
(setq r
(mapcar #'(lambda (x)
(mapcar #'(lambda (y) 1)
'(nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil)))
'(nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil)))
(print r)
(assert (equal
(make-list 26 :initial-element (make-list 26 :initial-element 1))
r))
))

(eval-when (load eval)
(run-all-tests)
(exit))
18 changes: 18 additions & 0 deletions test/geo.l
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
(init-unit-test)

(in-package "GEO")
;; redefined to use normalize-vector defined in irteus(?)
;; this requrie to avoid outer circuit not found in (body+ c1 b d1 c2 d2 c3 d3 c4 d4)
(defun face-normal-vector (vertices)
(let* ((v1 (first vertices)) (v2) (vlist (rest vertices))
(v (float-vector 0 0 0))
Expand Down Expand Up @@ -38,6 +40,22 @@
(assert (eps= (send f :distance (float-vector 200 0 100)) (norm #f(100 100))))
))

;; test intersection3
;; https://github.com/euslisp/jskeus/pull/561
(deftest triangulation-intersection3 ()
(let ((l0 (make-line (float-vector -120.0 -30.0 0.0) (float-vector 15.0 0.0 0.0)))
(l1 (make-line (float-vector -15.0 120.0 0.0) (float-vector -15.0 0.0 0.0)))
res-p res-n)
(setq res-p (geo::line-intersection3 (l0 . pvert) (l0 . nvert) (l1 . pvert) (l1 . nvert) 0.00001)) ;; -> (0.777778 1.05556)
(setq res-n (geo::line-intersection3 (l1 . pvert) (l1 . nvert) (l0 . pvert) (l0 . nvert) 0.00001)) ;; -> (1.05556 0.777778)
(warn ";;; intersection3 (res-p) ~A~%" res-p)
(warn ";;; intersection3 (res-n) ~A~%" res-n)

(assert (eps= (elt res-p 0) (elt res-n 1)))
(assert (eps= (elt res-p 1) (elt res-n 0)))
))


(eval-when (load eval)
(run-all-tests)
(exit))

1 comment on commit 21a5d86

@k-okada
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thank you for contributing EusLisp documentation

Please check latest documents before merging

PDF version of English manual: manual.pdf
PDF version of Japanese jmanual: jmanual.pdf
HTML version of English manual: manual.html
HTML version of Japanese manual: jmanual.html
Sphinx (ReST) version of English manual: manual.rst

Please sign in to comment.