Merge pull request #432 from k-okada/fix_intersection3_entry2

add tests that fails in armhf

Author: k-okada

.travis.sh

@@ -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";
 
@@ -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)
@@ -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
 
@@ -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

lisp/Makefile.LinuxARM

@@ -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

lisp/c/big.c

@@ -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);
   }
 

lisp/c/eus.h

@@ -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))
@@ -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

lisp/c/loadelf.c

@@ -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); }
@@ -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);
@@ -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);
@@ -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); }

lisp/c/makes.c

@@ -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);}
 
@@ -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);*/

lisp/comp/trans.l

@@ -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)
@@ -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)

lisp/geo/intersection.c

@@ -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);
@@ -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))); }
 
 
 /*

test/env.l

@@ -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))

test/geo.l

@@ -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))
@@ -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))