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

Commits:

2 changed files:

Changes:

  • tests/issues.lisp
    ... ... @@ -991,13 +991,15 @@
    991 991 
       ;; load-foreign apparently returns NIL if it succeeds.
    992 992 
       (assert-true (eql nil (ext:load-foreign (merge-pathnames "test-return.o" *test-path*)))))
    993 993
    994 
    +(alien:def-alien-variable "test_arg" c-call:int)
    995 
    +
    994 996 
     (define-test issue.242.test-alien-return-signed-char
    995 997 
       (:tag :issues)
    996 998 
       (flet ((fun (n)
    999 
    +	   (setf test-arg n)
    997 1000 
     	   (alien:alien-funcall
    998 1001 
     	    (alien:extern-alien "int_to_signed_char"
    999 
    -				(function c-call:char c-call:int))
    1000 
    -	    n))
    1002 
    +				(function c-call:char))))
    1001 1003 
     	 (sign-extend (n)
    1002 1004 
     	   (let ((n (ldb (byte 8 0) n)))
    1003 1005 
     	     (if (> n #x7f)
    ... ... @@ -1009,10 +1011,10 @@
    1009 1011 
     (define-test issue.242.test-alien-return-signed-short
    1010 1012 
       (:tag :issues)
    1011 1013 
       (flet ((fun (n)
    1014 
    +	   (setf test-arg n)
    1012 1015 
     	   (alien:alien-funcall
    1013 1016 
     	    (alien:extern-alien "int_to_short"
    1014 
    -				(function c-call:short c-call:int))
    1015 
    -	    n))
    1017 
    +				(function c-call:short))))
    1016 1018 
     	 (sign-extend (n)
    1017 1019 
     	   (let ((n (ldb (byte 16 0) n)))
    1018 1020 
     	     (if (> n #x7fff)
    ... ... @@ -1024,20 +1026,20 @@
    1024 1026 
     (define-test issue.242.test-alien-return-signed-int
    1025 1027 
       (:tag :issues)
    1026 1028 
       (flet ((fun (n)
    1029 
    +	   (setf test-arg n)
    1027 1030 
     	   (alien:alien-funcall
    1028 1031 
     	    (alien:extern-alien "int_to_int"
    1029 
    -				(function c-call:int c-call:int))
    1030 
    -	    n)))
    1032 
    +				(function c-call:int)))))
    1031 1033 
         (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
    1032 1034 
           (assert-equal x (fun x) x))))
    1033 1035
    1034 1036 
     (define-test issue.242.test-alien-return-unsigned-char
    1035 1037 
       (:tag :issues)
    1036 1038 
       (flet ((fun (n)
    1039 
    +	   (setf test-arg n)
    1037 1040 
     	   (alien:alien-funcall
    1038 1041 
     	    (alien:extern-alien "int_to_unsigned_char"
    1039 
    -				(function c-call:unsigned-char c-call:int))
    1040 
    -	    n))
    1042 
    +				(function c-call:unsigned-char))))
    1041 1043 
     	 (expected (n)
    1042 1044 
     	   (ldb (byte 8 0) n)))
    1043 1045 
         (dolist (x '(99 -99 1023 -1023))
    ... ... @@ -1046,10 +1048,10 @@
    1046 1048 
     (define-test issue.242.test-alien-return-unsigned-short
    1047 1049 
       (:tag :issues)
    1048 1050 
       (flet ((fun (n)
    1051 
    +	   (setf test-arg n)
    1049 1052 
     	   (alien:alien-funcall
    1050 1053 
     	    (alien:extern-alien "int_to_unsigned_short"
    1051 
    -				(function c-call:unsigned-short c-call:int))
    1052 
    -	    n))
    1054 
    +				(function c-call:unsigned-short))))
    1053 1055 
     	 (expected (n)
    1054 1056 
     	   (ldb (byte 16 0) n)))
    1055 1057 
         (dolist (x '(1023 -1023 100000 -100000))
    ... ... @@ -1058,10 +1060,10 @@
    1058 1060 
     (define-test issue.242.test-alien-return-unsigned-int
    1059 1061 
       (:tag :issues)
    1060 1062 
       (flet ((fun (n)
    1063 
    +	   (setf test-arg n)
    1061 1064 
     	   (alien:alien-funcall
    1062 1065 
     	    (alien:extern-alien "int_to_unsigned_int"
    1063 
    -				(function c-call:unsigned-int c-call:int))
    1064 
    -	    n))
    1066 
    +				(function c-call:unsigned-int))))
    1065 1067 
     	 (expected (n)
    1066 1068 
     	   (ldb (byte 32 0) n)))
    1067 1069 
         (dolist (x '(1023 -1023 #x7fffffff #x-80000000))
    ... ... @@ -1070,10 +1072,10 @@
    1070 1072 
     (define-test issue.242.test-alien-return-bool
    1071 1073 
       (:tag :issues)
    1072 1074 
       (flet ((fun (n)
    1075 
    +	   (setf test-arg n)
    1073 1076 
     	   (alien:alien-funcall
    1074 1077 
     	    (alien:extern-alien "unsigned_to_bool"
    1075 
    -				(function c-call:char c-call:unsigned-int))
    1076 
    -	    n))
    1078 
    +				(function c-call:char))))
    1077 1079 
     	 (expected (n)
    1078 1080 
     	   (if (zerop n)
    1079 1081 
     	       0
    ... ... @@ -1084,10 +1086,10 @@
    1084 1086 
     (define-test issue.242.test-alien-return-bool.2
    1085 1087 
       (:tag :issues)
    1086 1088 
       (flet ((fun (n)
    1089 
    +	   (setf test-arg n)
    1087 1090 
     	   (alien:alien-funcall
    1088 1091 
     	    (alien:extern-alien "unsigned_to_bool"
    1089 
    -				(function alien:boolean c-call:unsigned-int))
    1090 
    -	    n))
    1092 
    +				(function alien:boolean))))
    1091 1093 
     	 (expected (n)
    1092 1094 
     	   (not (zerop n))))
    1093 1095 
         (dolist (x '(0 1 1000))

  • tests/test-return.c
    1 1 
     #include <stdbool.h>
    2 2
    3 
    +int test_arg;
    4 
    +
    3 5 
     signed char
    4 
    -int_to_signed_char(int x)
    6 
    +int_to_signed_char()
    5 7 
     {
    6 
    -  return (signed char) x;
    8 
    +  return (signed char) test_arg;
    7 9 
     }
    8 10
    9 11 
     short
    10 
    -int_to_short(int x)
    12 
    +int_to_short()
    11 13 
     {
    12 
    -  return (short) x;
    14 
    +  return (short) test_arg;
    13 15 
     }
    14 16
    15 17 
     int
    16 
    -int_to_int(int x)
    18 
    +int_to_int()
    17 19 
     {
    18 
    -  return (int) x;
    20 
    +  return (int) test_arg;
    19 21 
     }
    20 22
    21 23 
     unsigned char
    22 
    -int_to_unsigned_char(int x)
    24 
    +int_to_unsigned_char()
    23 25 
     {
    24 
    -  return (unsigned char) x;
    26 
    +  return (unsigned char) test_arg;
    25 27 
     }
    26 28
    27 29 
     unsigned short
    28 
    -int_to_unsigned_short(int x)
    30 
    +int_to_unsigned_short()
    29 31 
     {
    30 
    -  return (unsigned short) x;
    32 
    +  return (unsigned short) test_arg;
    31 33 
     }
    32 34
    33 35 
     unsigned int
    34 
    -int_to_unsigned_int(int x)
    36 
    +int_to_unsigned_int()
    35 37 
     {
    36 
    -  return (unsigned int) x;
    38 
    +  return (unsigned int) test_arg;
    37 39 
     }
    38 40
    39 
    -_Bool unsigned_to_bool(unsigned u)
    41 
    +_Bool unsigned_to_bool()
    40 42 
     {
    41 
    -  return (_Bool) u;
    43 
    +  return (_Bool) test_arg;
    42 44 
     }
    43 45

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help