X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fforeign.test.sh;h=c9989bc6faefc7e38ea8708ea52657c75a1dbf42;hb=007bcd5aac2f3a1e714563bd39f7a2db2d0bf7c2;hp=6e761335d3e8df4f5dd6b1eaca77a74e3b90414d;hpb=60053af56e69de2fd251cde8fcdb2ea7f01d0b01;p=sbcl.git

diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh
index 6e76133..c9989bc 100644
--- a/tests/foreign.test.sh
+++ b/tests/foreign.test.sh
@@ -14,7 +14,9 @@
 # absolutely no warranty. See the COPYING and CREDITS files for
 # more information.
 
+. ./expect.sh
 . ./subr.sh
+
 use_test_subdirectory
 
 echo //entering foreign.test.sh
@@ -36,6 +38,9 @@ build_so() (
   esac
   if [ "`uname`" = Darwin ]; then
     SO_FLAGS="-bundle"
+    if run_sbcl --eval '(sb-ext:quit :unix-status #+x86-64 0 #-x86-64 1)'; then
+	CFLAGS="$CFLAGS -arch x86_64"
+    fi
   else
     SO_FLAGS="-shared"
   fi
@@ -97,6 +102,14 @@ int long_test2(int i1, int i2, int i3, int i4, int i5, int i6,
     return (l1 == (1 + powish(2,37)));
 }
 
+int long_sap_test1(int *p1, long long l1) {
+    return (l1 == (3 + powish(2,*p1)));
+}
+
+int long_sap_test2(int *p1, int i1, long long l1) {
+    return (l1 == (3 + powish(2,*p1)));
+}
+
 long long return_long_long() {
     return powish(2,33);
 }
@@ -124,8 +137,8 @@ cat > $TEST_FILESTEM.base.lisp <<EOF
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (handler-case
         (progn
-          (load-shared-object "$TEST_FILESTEM.so")
-          (load-shared-object "$TEST_FILESTEM-b.so"))
+          (load-shared-object (truename "$TEST_FILESTEM.so"))
+          (load-shared-object (truename "$TEST_FILESTEM-b.so")))
       (sb-int:unsupported-operator ()
         ;; At least as of sbcl-0.7.0.5, LOAD-SHARED-OBJECT isn't
         ;; supported on every OS. In that case, there's nothing to test,
@@ -147,6 +160,8 @@ cat > $TEST_FILESTEM.base.lisp <<EOF
   (define-alien-routine long-test8 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (long1 (integer 64)))
   (define-alien-routine long-test9 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (long1 (integer 64)) (int8 int))
   (define-alien-routine long-test2 int (int1 int) (int2 int) (int3 int) (int4 int) (int5 int) (int6 int) (int7 int) (int8 int) (int9 int) (long1 (integer 64)) (long2 (integer 64)))
+  (define-alien-routine long-sap-test1 int (ptr1 int :copy) (long1 (integer 64)))
+  (define-alien-routine long-sap-test2 int (ptr1 int :copy) (int1 int) (long1 (integer 64)))
   (define-alien-routine return-long-long (integer 64))
 
   ;; compiling this gets us the FOP-FOREIGN-DATAREF-FIXUP on
@@ -211,6 +226,8 @@ cat > $TEST_FILESTEM.test.lisp <<EOF
   (assert (= 1 (long-test8 1 2 3 4 5 6 7 (ash 1 34))))
   (assert (= 1 (long-test9 1 2 3 4 5 6 7 (ash 1 35) 8)))
   (assert (= 1 (long-test2 1 2 3 4 5 6 7 8 9 (+ 1 (ash 1 37)) 15)))
+  (assert (= 1 (long-sap-test1 38 (+ 3 (ash 1 38)))))
+  (assert (= 1 (long-sap-test2 38 1 (+ 3 (ash 1 38)))))
   (assert (= (ash 1 33) (return-long-long)))
 
   (note "/initial assertions ok")
@@ -221,7 +238,7 @@ cat > $TEST_FILESTEM.test.lisp <<EOF
   (note "/original definitions ok")
   (rename-file "$TEST_FILESTEM-b.so" "$TEST_FILESTEM-b.bak")
   (rename-file "$TEST_FILESTEM-b2.so" "$TEST_FILESTEM-b.so")
-  (load-shared-object "$TEST_FILESTEM-b.so")
+  (load-shared-object (truename "$TEST_FILESTEM-b.so"))
   (note "/reloading ok")
   (assert (= 42 foo))
   (assert (= 13 (bar)))
@@ -242,9 +259,16 @@ cat > $TEST_FILESTEM.test.lisp <<EOF
     (multiple-value-bind (val err) (ignore-errors (late-bar))
       (assert (not val))
       (assert (typep err 'undefined-alien-error)))
-    (load-shared-object "$TEST_FILESTEM-c.so")
+    (load-shared-object (truename "$TEST_FILESTEM-c.so"))
     (assert (= 43 late-foo))
     (assert (= 14 (late-bar)))
+    (unload-shared-object (truename "$TEST_FILESTEM-c.so"))
+    (multiple-value-bind (val err) (ignore-errors late-foo)
+      (assert (not val))
+      (assert (typep err 'undefined-alien-error)))
+    (multiple-value-bind (val err) (ignore-errors (late-bar))
+      (assert (not val))
+      (assert (typep err 'undefined-alien-error)))
     (note "/linkage table ok"))
 
   (sb-ext:quit :unix-status $EXIT_LISP_WIN) ; success convention for Lisp program
@@ -322,7 +346,7 @@ EOF
 build_so $TEST_FILESTEM.addr.heap
 
 run_sbcl <<EOF
-  (load-shared-object "$TEST_FILESTEM.addr.heap.so")
+  (load-shared-object (truename "$TEST_FILESTEM.addr.heap.so"))
   (define-alien-type foo (struct foo (x int) (y int)))
 
   (define-alien-variable a foo)
@@ -333,6 +357,44 @@ run_sbcl <<EOF
 EOF
 check_status_maybe_lose "ADDR of a heap-allocated object" $?
 
+run_sbcl <<EOF
+  (define-alien-type inner (struct inner (var (unsigned 32))))
+  (define-alien-type outer (struct outer (one inner) (two inner)))
+
+  (defvar *outer* (make-alien outer))
+  (defvar *inner* (make-alien inner))
+  (setf (slot *inner* 'var) 20)
+  (setf (slot *outer* 'one) *inner*)
+  (assert (= (slot (slot *outer* 'one) 'var) 20))
+  (setf (slot *inner* 'var) 40)
+  (setf (slot *outer* 'two) *inner*)
+  (assert (= (slot (slot *outer* 'two) 'var) 40))
+  (quit :unix-status $EXIT_LISP_WIN)
+EOF
+check_status_maybe_lose "struct offsets" $?
+
+cat > $TEST_FILESTEM.alien.enum.lisp <<EOF
+(define-alien-type foo-flag
+  (enum foo-flag-
+    (:a 1)
+    (:b 2)))
+
+(define-alien-type bar
+  (struct bar
+    (foo-flag foo-flag)))
+
+(define-alien-type barp
+  (* bar))
+
+(defun foo (x)
+  (declare (type (alien barp) x))
+  x)
+
+(defun bar (x)
+  (declare (type (alien barp) x))
+  x)
+EOF
+expect_clean_compile $TEST_FILESTEM.alien.enum.lisp
 
 # success convention for script
 exit $EXIT_TEST_WIN