[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Remove arg from test function and set the value directly.

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl


Commits:
1f87ddfc by Raymond Toy at 2023-06-30T21:33:50-07:00
Remove arg from test function and set the value directly.

As suggested by @cshapiro, define a global var that we can set and
which is used by the functions to compute the return value.  This
reduces any possible issues with round-tripping a value through the
FFI.

Update the tests appropriately to define the alien variable and set it
before calling the test function.

- - - - -


2 changed files:

- tests/issues.lisp
- tests/test-return.c


Changes:

=====================================
tests/issues.lisp
=====================================
@@ -991,13 +991,15 @@
   ;; load-foreign apparently returns NIL if it succeeds.
   (assert-true (eql nil (ext:load-foreign (merge-pathnames "test-return.o" *test-path*)))))
 
+(alien:def-alien-variable "test_arg" c-call:int)
+
 (define-test issue.242.test-alien-return-signed-char
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_signed_char"
-				(function c-call:char c-call:int))
-	    n))
+				(function c-call:char))))
 	 (sign-extend (n)
 	   (let ((n (ldb (byte 8 0) n)))
 	     (if (> n #x7f)
@@ -1009,10 +1011,10 @@
 (define-test issue.242.test-alien-return-signed-short
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_short"
-				(function c-call:short c-call:int))
-	    n))
+				(function c-call:short))))
 	 (sign-extend (n)
 	   (let ((n (ldb (byte 16 0) n)))
 	     (if (> n #x7fff)
@@ -1024,20 +1026,20 @@
 (define-test issue.242.test-alien-return-signed-int
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_int"
-				(function c-call:int c-call:int))
-	    n)))
+				(function c-call:int)))))
     (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
       (assert-equal x (fun x) x))))
 
 (define-test issue.242.test-alien-return-unsigned-char
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_unsigned_char"
-				(function c-call:unsigned-char c-call:int))
-	    n))
+				(function c-call:unsigned-char))))
 	 (expected (n)
 	   (ldb (byte 8 0) n)))
     (dolist (x '(99 -99 1023 -1023))
@@ -1046,10 +1048,10 @@
 (define-test issue.242.test-alien-return-unsigned-short
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_unsigned_short"
-				(function c-call:unsigned-short c-call:int))
-	    n))
+				(function c-call:unsigned-short))))
 	 (expected (n)
 	   (ldb (byte 16 0) n)))
     (dolist (x '(1023 -1023 100000 -100000))
@@ -1058,10 +1060,10 @@
 (define-test issue.242.test-alien-return-unsigned-int
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "int_to_unsigned_int"
-				(function c-call:unsigned-int c-call:int))
-	    n))
+				(function c-call:unsigned-int))))
 	 (expected (n)
 	   (ldb (byte 32 0) n)))
     (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
@@ -1070,10 +1072,10 @@
 (define-test issue.242.test-alien-return-bool
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "unsigned_to_bool"
-				(function c-call:char c-call:unsigned-int))
-	    n))
+				(function c-call:char))))
 	 (expected (n)
 	   (if (zerop n)
 	       0
@@ -1084,10 +1086,10 @@
 (define-test issue.242.test-alien-return-bool.2
   (:tag :issues)
   (flet ((fun (n)
+	   (setf test-arg n)
 	   (alien:alien-funcall
 	    (alien:extern-alien "unsigned_to_bool"
-				(function alien:boolean c-call:unsigned-int))
-	    n))
+				(function alien:boolean))))
 	 (expected (n)
 	   (not (zerop n))))
     (dolist (x '(0 1 1000))


=====================================
tests/test-return.c
=====================================
@@ -1,43 +1,45 @@
 #include <stdbool.h>
 
+int test_arg;
+
 signed char
-int_to_signed_char(int x)
+int_to_signed_char()
 {
-  return (signed char) x;
+  return (signed char) test_arg;
 }
 
 short
-int_to_short(int x)
+int_to_short()
 {
-  return (short) x;
+  return (short) test_arg;
 }
 
 int
-int_to_int(int x)
+int_to_int()
 {
-  return (int) x;
+  return (int) test_arg;
 }
 
 unsigned char
-int_to_unsigned_char(int x)
+int_to_unsigned_char()
 {
-  return (unsigned char) x;
+  return (unsigned char) test_arg;
 }
 
 unsigned short
-int_to_unsigned_short(int x)
+int_to_unsigned_short()
 {
-  return (unsigned short) x;
+  return (unsigned short) test_arg;
 }
 
 unsigned int
-int_to_unsigned_int(int x)
+int_to_unsigned_int()
 {
-  return (unsigned int) x;
+  return (unsigned int) test_arg;
 }
 
-_Bool unsigned_to_bool(unsigned u)
+_Bool unsigned_to_bool()
 {
-  return (_Bool) u;
+  return (_Bool) test_arg;
 }
 



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f87ddfc5760085d3426604aa6a400e372da3a70

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f87ddfc5760085d3426604aa6a400e372da3a70
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230701/509cd8df/attachment-0001.html>