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/1f87ddfc5760085d3426604a...