[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] 2 commits: Add tests for unsigned return types

[Raymond Toy (@rtoy)]

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


Commits:
d7f0d936 by Raymond Toy at 2023-06-16T06:29:46-07:00
Add tests for unsigned return types

- - - - -
10a18a52 by Raymond Toy at 2023-06-16T06:35:11-07:00
Add comment on what :naturalize-gen method does

Since I can never remember, add a comment for what the
`:naturalize-gen` alien method is for.

- - - - -


2 changed files:

- src/code/alieneval.lisp
- tests/issues.lisp


Changes:

=====================================
src/code/alieneval.lisp
=====================================
@@ -170,7 +170,10 @@
   (alien-rep nil :type (or null function))
   (extract-gen nil :type (or null function))
   (deposit-gen nil :type (or null function))
-  (naturalize-gen nil :type (or null function))
+  ;;
+  ;; Method that accepts the alien type and the alien value.  The
+  ;; method converts the alien value into an appropriate lisp value.
+  (naturalize-gen nil :type (or null function)
   (deport-gen nil :type (or null function))
   ;; Cast?
   (arg-tn nil :type (or null function))


=====================================
tests/issues.lisp
=====================================
@@ -1036,3 +1036,39 @@
 	    n)))
     (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
       (assert-equal x (fun x)))))
+
+(define-test issue.242.test-alien-return-unsigned-char
+  (:tag :issues)
+  (flet ((fun (n)
+	   (alien:alien-funcall
+	    (alien:extern-alien "int_to_unsigned_char"
+				(function c-call:unsigned-char c-call:int))
+	    n))
+	 (expected (n)
+	   (ldb (byte 8 0) n)))
+    (dolist (x '(99 -99 1023 -1023))
+      (assert-equal (expected x) (fun x)))))
+
+(define-test issue.242.test-alien-return-unsigned-short
+  (:tag :issues)
+  (flet ((fun (n)
+	   (alien:alien-funcall
+	    (alien:extern-alien "int_to_unsigned_short"
+				(function c-call:unsigned-short c-call:int))
+	    n))
+	 (expected (n)
+	   (ldb (byte 16 0) n)))
+    (dolist (x '(1023 -1023 100000 -100000))
+      (assert-equal (expected x) (fun x)))))
+
+(define-test issue.242.test-alien-return-unsigned-int
+  (:tag :issues)
+  (flet ((fun (n)
+	   (alien:alien-funcall
+	    (alien:extern-alien "int_to_unsigned_int"
+				(function c-call:unsigned-int c-call:int))
+	    n))
+	 (expected (n)
+	   (ldb (byte 32 0) n)))
+    (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
+      (assert-equal (expected x) (fun x)))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2cc3c60e2692a1709fcf4852f7fdc413b4accf81...10a18a52c01b8a5e03ebe3587e97664b0b2ffe7f

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2cc3c60e2692a1709fcf4852f7fdc413b4accf81...10a18a52c01b8a5e03ebe3587e97664b0b2ffe7f
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/4e395b38/attachment-0001.html>