[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Add original C test from the bug report.

[Raymond Toy (@rtoy)]

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


Commits:
e8c35cb7 by Raymond Toy at 2023-06-16T07:07:11-07:00
Add original C test from the bug report.

Add tests for this as well from the original bug report and an
additional test that uses alien:boolean as the return type.

- - - - -


2 changed files:

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


Changes:

=====================================
tests/issues.lisp
=====================================
@@ -1004,7 +1004,7 @@
 		 (- n #x100)
 		 n))))
     (dolist (x '(99 -99 1023 -1023))
-      (assert-equal (sign-extend x) (fun x)))))
+      (assert-equal (sign-extend x) (fun x) x))))
 
 (define-test issue.242.test-alien-return-signed-short
   (:tag :issues)
@@ -1019,7 +1019,7 @@
 		 (- n #x10000)
 		 n))))
     (dolist (x '(1023 -1023 100000 -100000))
-      (assert-equal (sign-extend x) (fun x)))))
+      (assert-equal (sign-extend x) (fun x) x))))
 
 (define-test issue.242.test-alien-return-signed-int
   (:tag :issues)
@@ -1029,7 +1029,7 @@
 				(function c-call:int c-call:int))
 	    n)))
     (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
-      (assert-equal x (fun x)))))
+      (assert-equal x (fun x) x))))
 
 (define-test issue.242.test-alien-return-unsigned-char
   (:tag :issues)
@@ -1041,7 +1041,7 @@
 	 (expected (n)
 	   (ldb (byte 8 0) n)))
     (dolist (x '(99 -99 1023 -1023))
-      (assert-equal (expected x) (fun x)))))
+      (assert-equal (expected x) (fun x) x))))
 
 (define-test issue.242.test-alien-return-unsigned-short
   (:tag :issues)
@@ -1053,7 +1053,7 @@
 	 (expected (n)
 	   (ldb (byte 16 0) n)))
     (dolist (x '(1023 -1023 100000 -100000))
-      (assert-equal (expected x) (fun x)))))
+      (assert-equal (expected x) (fun x) x))))
 
 (define-test issue.242.test-alien-return-unsigned-int
   (:tag :issues)
@@ -1065,4 +1065,30 @@
 	 (expected (n)
 	   (ldb (byte 32 0) n)))
     (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
-      (assert-equal (expected x) (fun x)))))
+      (assert-equal (expected x) (fun x) x))))
+
+(define-test issue.242.test-alien-return-bool
+  (:tag :issues)
+  (flet ((fun (n)
+	   (alien:alien-funcall
+	    (alien:extern-alien "unsigned_to_bool"
+				(function c-call:char c-call:unsigned-int))
+	    n))
+	 (expected (n)
+	   (if (zerop n)
+	       0
+	       1)))
+    (dolist (x '(0 1 1000))
+      (assert-equal (expected x) (fun x) x))))
+
+(define-test issue.242.test-alien-return-bool.2
+  (:tag :issues)
+  (flet ((fun (n)
+	   (alien:alien-funcall
+	    (alien:extern-alien "unsigned_to_bool"
+				(function alien:boolean c-call:unsigned-int))
+	    n))
+	 (expected (n)
+	   (not (zerop n))))
+    (dolist (x '(0 1 1000))
+      (assert-equal (expected x) (fun x) x))))


=====================================
tests/test-return.c
=====================================
@@ -1,3 +1,5 @@
+#include <stdbool.h>
+
 signed char
 int_to_signed_char(int x)
 {
@@ -19,18 +21,23 @@ int_to_int(int x)
 unsigned char
 int_to_unsigned_char(int x)
 {
-  return (signed char) x;
+  return (unsigned char) x;
 }
 
 unsigned short
 int_to_unsigned_short(int x)
 {
-  return (signed short) x;
+  return (unsigned short) x;
 }
 
 unsigned int
 int_to_unsigned_int(int x)
 {
-  return (int) x;
+  return (unsigned int) x;
+}
+
+_Bool unsigned_to_bool(unsigned u)
+{
+  return (_Bool) u;
 }
 



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

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e8c35cb738dbac4d469d70ccf06762802cdca682
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/20230616/cfddf49b/attachment-0001.html>