Skip to content

Commit 21a5d86

Browse files
k-okadak-okada
authored
Merge pull request #432 from k-okada/fix_intersection3_entry2
add tests that fails in armhf
2 parents 40051e5 + 218ba0f commit 21a5d86

File tree

10 files changed

+129
-17
lines changed

10 files changed

+129
-17
lines changed

‎.travis.sh

+23-6
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,23 @@ if [ "$QEMU" != "" ]; then
9999
travis_time_end `expr 32 - $TMP_EXIT_STATUS`
100100

101101
export EXIT_STATUS=`expr $TMP_EXIT_STATUS + $EXIT_STATUS`;
102+
103+
travis_time_start compiled.${test_l##*/}.test
104+
105+
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))))"
106+
export TMP_EXIT_STATUS=$?
107+
108+
export CONTINUE=0
109+
# const.l does not compilable https://github.com/euslisp/EusLisp/issues/318
110+
if [[ $test_l =~ const.l ]]; then export CONTINUE=1; fi
111+
112+
if [[ $CONTINUE == 0 ]]; then travis_time_end `expr 32 - $TMP_EXIT_STATUS`; else travis_time_end 33; fi
113+
114+
if [[ $TMP_EXIT_STATUS != 0 ]]; then echo "Failed running $test_l. Exiting with $TMP_EXIT_STATUS"; fi
115+
116+
if [[ $CONTINUE != 0 ]]; then continue; fi
117+
118+
export EXIT_STATUS=`expr $TMP_EXIT_STATUS + $EXIT_STATUS`;
102119
done;
103120
echo "Exit status : $EXIT_STATUS";
104121

@@ -129,8 +146,14 @@ if [[ "$DOCKER_IMAGE" == *"trusty"* || "$DOCKER_IMAGE" == *"jessie"* ]]; then
129146
else
130147
make eus-installed WFLAGS="-Werror=implicit-int -Werror=implicit-function-declaration -Werror=incompatible-pointer-types -Werror=int-conversion -Werror=unused-result"
131148
fi
149+
travis_time_end
150+
151+
travis_time_start script.make.jskeus
152+
132153
make
133154

155+
travis_time_end
156+
134157
travis_time_start script.eustag
135158

136159
(cd eus/lisp/tool; make)
@@ -237,10 +260,6 @@ fi
237260
export TMP_EXIT_STATUS=$?
238261

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

@@ -263,8 +282,6 @@ fi
263282
export TMP_EXIT_STATUS=$?
264283

265284
export CONTINUE=0
266-
# irteus-demo.l, robot-model-usage.l and test-irt-motion.l fails on armhf both trusty and xenial
267-
if [[ "`uname -m`" == "arm"* && $test_l =~ irteus-demo.l|robot-model-usage.l|test-irt-motion.l ]]; then export CONTINUE=1; fi
268285
# skip collision test because bullet of 2.83 or later version is not released in trusty and jessie.
269286
# https://github.com/euslisp/jskeus/blob/6cb08aa6c66fa8759591de25b7da68baf76d5f09/irteus/Makefile#L37
270287
if [[ ( "$DOCKER_IMAGE" == *"trusty"* || "$DOCKER_IMAGE" == *"jessie"* ) && $test_l =~ test-collision.l ]]; then export CONTINUE=1; fi

‎lisp/Makefile.LinuxARM

-2
Original file line numberDiff line numberDiff line change
@@ -46,11 +46,9 @@ ifeq ($(GCC_MAJOR_VERSION), 2)
4646
ADD_CFLAGS=-fno-stack-protector -fpic
4747
else
4848
ifeq ($(MACHINE), aarch64)
49-
CPU_OPTIMIZE=-march=armv8-a
5049
ALIGN_FUNCTIONS=-falign-functions=8
5150
ADD_CFLAGS=-fPIC -Darmv8
5251
else
53-
CPU_OPTIMIZE=-march=$(MACHINE)
5452
ALIGN_FUNCTIONS=-falign-functions=4
5553
ADD_CFLAGS=-fno-stack-protector -fpic
5654
endif

‎lisp/c/big.c

+1
Original file line numberDiff line numberDiff line change
@@ -364,6 +364,7 @@ eusinteger_t i;
364364
for (j=0; j<vlen; j++) newv->c.ivec.iv[j]=bn->c.ivec.iv[j];
365365
newv->c.ivec.iv[vlen]=i;
366366
pointer_update(x->c.bgnm.bv, newv);
367+
x->c.bgnm.size=makeint(vlen+1);
367368
return(newv);
368369
}
369370

‎lisp/c/eus.h

+2
Original file line numberDiff line numberDiff line change
@@ -737,6 +737,7 @@ extern int export_all;
737737
#define isint(p) (!((eusinteger_t)(p) & 3))
738738
#define isflt(p) (((eusinteger_t)(p) & 3)==1)
739739
#define isnum(p) (((eusinteger_t)(p) & 2)==0)
740+
#define numberp(p) (((isnum(p)) || (pisextnum(p)))) // predicates.c:NUMBERP
740741
#define ispointer(p) ((eusinteger_t)(p) & 2)
741742
#define makeint(v) ((pointer)(((eusinteger_t)v)<<2))
742743
#define bpointerof(p) ((bpointer)((eusinteger_t)(p)-2))
@@ -749,6 +750,7 @@ extern int export_all;
749750
#define isint(p) ( (((eusinteger_t)(p)&3)==2) || (((eusinteger_t)(p)&0x3)==0x3) )
750751
#define isflt(p) (((eusinteger_t)(p) & 3)==1)
751752
#define isnum(p) (((eusinteger_t)(p) & 3))
753+
#define numberp(p) (((isnum(p)) || (pisextnum(p)))) // predicates.c:NUMBERP
752754
#define ispointer(p) (!((eusinteger_t)(p) & 3))
753755
// #define makeint(v) ((pointer)((((eusinteger_t)(v))<<2)+2)) // org
754756
#ifdef __cplusplus

‎lisp/c/loadelf.c

+4-4
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ register context *ctx;
113113
addr= addr>>2;
114114
mod->c.ldmod.entry=makeint(addr);
115115
#if ARM
116-
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
116+
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
117117
#endif
118118
mod->c.ldmod.subrtype=SUBR_ENTRY;
119119
(*initfunc)(ctx,1, &mod); }
@@ -180,7 +180,7 @@ pointer initnames;
180180
mod->c.ldmod.codevec=makeint(0);
181181
mod->c.ldmod.entry=makeint(addr);
182182
#if ARM
183-
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
183+
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
184184
#endif
185185
mod->c.ldmod.subrtype=SUBR_FUNCTION;
186186
p=cons(ctx,mod, NIL);
@@ -231,7 +231,7 @@ pointer *argv;
231231
mod->c.ldmod.codevec=makeint(0);
232232
mod->c.ldmod.entry=makeint(addr);
233233
#if ARM
234-
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
234+
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
235235
#endif
236236
mod->c.ldmod.subrtype=SUBR_FUNCTION;
237237
p=cons(ctx,mod, NIL);
@@ -409,7 +409,7 @@ pointer *argv;
409409
mod->c.ldmod.codevec=makeint(0);
410410
mod->c.ldmod.entry=makeint(addr);
411411
#if ARM
412-
mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
412+
mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
413413
#endif
414414
mod->c.ldmod.subrtype=SUBR_FUNCTION;
415415
(*initfunc)(ctx, 1, &mod); }

‎lisp/c/makes.c

+2-2
Original file line numberDiff line numberDiff line change
@@ -292,7 +292,7 @@ pointer (*f)();
292292
fentaddr= (eusinteger_t)f>>2;
293293
cd->c.code.entry=makeint(fentaddr);
294294
#if ARM
295-
cd->c.code.entry2=makeint((eusinteger_t)f);
295+
cd->c.code.entry2=makeint(((eusinteger_t)f)&0x3);
296296
#endif
297297
return(cd);}
298298

@@ -513,7 +513,7 @@ pointer (*f)();
513513
clo->c.clo.subrtype=SUBR_FUNCTION;
514514
clo->c.clo.entry=makeint((eusinteger_t)f>>2);
515515
#if ARM
516-
clo->c.clo.entry2=makeint((eusinteger_t)f);
516+
clo->c.clo.entry2=makeint(((eusinteger_t)f)&0x3);
517517
#endif
518518
clo->c.clo.env0=e0;
519519
clo->c.clo.env1=e1; /*makeint((int)e1>>2);*/

‎lisp/comp/trans.l

+2-2
Original file line numberDiff line numberDiff line change
@@ -438,7 +438,7 @@
438438
(send self :push
439439
(format nil "(~A(w)?T:NIL)"
440440
(cdr (assoc pred '((symbolp . "issymbol") (consp . "iscons")
441-
(numberp . "isnum") (integerp . "isint")
441+
(numberp . "numberp") (integerp . "isint")
442442
(floatp . "isflt") (stringp . "isstring")
443443
))))))
444444
(:if-nil (lab)
@@ -511,7 +511,7 @@
511511
;;; type check
512512
(:type-checker (tn)
513513
(cdr (assq tn '((symbolp . "issymbol") (integerp . "isint")
514-
(numberp . "isnum")
514+
(numberp . "numberp")
515515
(floatp . "isflt") (atom . "!iscons")
516516
(consp . "iscons") (stringp . "isstring")))))
517517
(:if-type (type lab)

‎lisp/geo/intersection.c

+3-1
Original file line numberDiff line numberDiff line change
@@ -91,6 +91,7 @@ register pointer argv[];
9191
eusfloat_t cz,u,v;
9292
eusfloat_t *p1, v1[3], *p2, v2[3], p2p1[3];
9393
eusfloat_t cross[3], cross2;
94+
pointer up,vp;
9495
numunion nu;
9596

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

116117
u=determinant3(p2p1,v2,cross)/cross2;
117118
v=determinant3(p2p1,v1,cross)/cross2;
118-
return(cons(ctx,makeflt(u),cons(ctx,makeflt(v),NIL))); }
119+
up=makeflt(u); vp=makeflt(v);
120+
return(cons(ctx,up,cons(ctx,vp,NIL))); }
119121

120122

121123
/*

‎test/env.l

+74
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
(require :unittest "lib/llib/unittest.l")
2+
3+
(init-unit-test)
4+
5+
(eval-when (compile) ;; this does not work on compiled code
6+
(when nil
7+
8+
;;(defun make-c (a) (let ((x 0)) #'(lambda () (list a x))))
9+
;;(defun make-c () (let ((x 0)) #'(lambda () (list x))))
10+
(defun make-c0 () #'(lambda () (list 0)))
11+
12+
(compile 'make-c0)
13+
(setq f0 (make-c0))
14+
15+
(deftest f0
16+
(format t ";; funcall make-c0 ~A~%" (funcall f0))
17+
(assert (equal (funcall f0) '(0))))
18+
19+
(defun make-c1 () (let () #'(lambda (x) (list x))))
20+
21+
(compile 'make-c1)
22+
(setq f1 (make-c1))
23+
24+
(deftest f1
25+
(format t ";; funcall make-c1 ~A~%" (funcall f1 1))
26+
(assert (equal (funcall f1 1) '(1))))
27+
28+
(defun make-c2 () (let ((x 0)) #'(lambda () (list x))))
29+
30+
(compile 'make-c2)
31+
(setq f2 (make-c2))
32+
33+
(deftest f2
34+
(format t ";; funcall make-c2 ~A~%" (funcall f2))
35+
(assert (equal (funcall f2) '(0))))
36+
37+
(setq *x* 2) (defun make-c3 () #'(lambda () (list *x*)))
38+
39+
(compile 'make-c3)
40+
(setq f3 (make-c3))
41+
42+
(deftest f3
43+
(format t ";; funcall make-c3 ~A~%" (funcall f3))
44+
(assert (equal (funcall f3) '(2))))
45+
46+
(defun make-c4 () #'(lambda (x) (list x)))
47+
48+
(compile 'make-c4)
49+
(setq f4 (make-c4))
50+
51+
(deftest f4
52+
(format t ";; funcall make-c4 ~A~%" (funcall f4 1))
53+
(assert (equal (funcall f4 1) '(1))))
54+
55+
)) ;; eval-when (compile) (when nil
56+
57+
(deftest lambda-in-lambda
58+
(let (r)
59+
(setq r
60+
(mapcar #'(lambda (x)
61+
(mapcar #'(lambda (y) 1)
62+
'(nil nil nil nil nil nil nil nil nil nil nil nil nil
63+
nil nil nil nil nil nil nil nil nil nil nil nil nil)))
64+
'(nil nil nil nil nil nil nil nil nil nil nil nil nil
65+
nil nil nil nil nil nil nil nil nil nil nil nil nil)))
66+
(print r)
67+
(assert (equal
68+
(make-list 26 :initial-element (make-list 26 :initial-element 1))
69+
r))
70+
))
71+
72+
(eval-when (load eval)
73+
(run-all-tests)
74+
(exit))

‎test/geo.l

+18
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,8 @@
33
(init-unit-test)
44

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

43+
;; test intersection3
44+
;; https://github.com/euslisp/jskeus/pull/561
45+
(deftest triangulation-intersection3 ()
46+
(let ((l0 (make-line (float-vector -120.0 -30.0 0.0) (float-vector 15.0 0.0 0.0)))
47+
(l1 (make-line (float-vector -15.0 120.0 0.0) (float-vector -15.0 0.0 0.0)))
48+
res-p res-n)
49+
(setq res-p (geo::line-intersection3 (l0 . pvert) (l0 . nvert) (l1 . pvert) (l1 . nvert) 0.00001)) ;; -> (0.777778 1.05556)
50+
(setq res-n (geo::line-intersection3 (l1 . pvert) (l1 . nvert) (l0 . pvert) (l0 . nvert) 0.00001)) ;; -> (1.05556 0.777778)
51+
(warn ";;; intersection3 (res-p) ~A~%" res-p)
52+
(warn ";;; intersection3 (res-n) ~A~%" res-n)
53+
54+
(assert (eps= (elt res-p 0) (elt res-n 1)))
55+
(assert (eps= (elt res-p 1) (elt res-n 0)))
56+
))
57+
58+
4159
(eval-when (load eval)
4260
(run-all-tests)
4361
(exit))

0 commit comments

Comments
 (0)