From 04b88bbf1cdbe409f1eac1695d129a2310c12290 Mon Sep 17 00:00:00 2001 From: fdopen Date: Mon, 27 Apr 2020 18:33:39 +0200 Subject: [PATCH 1/2] add a test case with a packed struct --- tests/clib/test_functions.c | 5 +++++ tests/clib/test_functions.h | 20 +++++++++++++++++++- tests/test-structs/stubs/types.ml | 7 +++++++ tests/test-structs/test_structs.ml | 26 ++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 1 deletion(-) diff --git a/tests/clib/test_functions.c b/tests/clib/test_functions.c index b80ebcbc1..634206b02 100644 --- a/tests/clib/test_functions.c +++ b/tests/clib/test_functions.c @@ -910,3 +910,8 @@ int call_saved_dynamic_funptr(int n) { int call_dynamic_funptr_struct(struct simple_closure x) { return x.f(x.n); } int call_dynamic_funptr_struct_ptr(struct simple_closure *x) { return x->f(x->n); } + +bool check_packed_struct(struct packed_struct *s, int8_t i8, int64_t i64, + long double _Complex *ldc, int32_t i32) { + return ( s->i8 == i8 && s->i64 == i64 && s->ldc == *ldc && s->i32 == i32 ); +} diff --git a/tests/clib/test_functions.h b/tests/clib/test_functions.h index aac876f2d..fe7d2ebca 100644 --- a/tests/clib/test_functions.h +++ b/tests/clib/test_functions.h @@ -165,7 +165,7 @@ struct one_int { int i; }; struct one_int return_struct_by_value(void); void matrix_mul(int, int, int, double *, double *, double *); double *matrix_transpose(int, int, double *); -int (*plus_callback)(int); +extern int (*plus_callback)(int); int sum_range_with_plus_callback(int, int); typedef int callback_t(void); void register_callback(callback_t *); @@ -282,4 +282,22 @@ struct simple_closure { int (*f)(int); int n; }; int call_dynamic_funptr_struct(struct simple_closure); int call_dynamic_funptr_struct_ptr(struct simple_closure*); +#if defined(_MSC_VER) && defined(_WIN32) +#define CTYPES_PACKED(name) \ + __pragma(pack(push, 1)) struct name __pragma(pack(pop)) +#elif defined(__GNUC__) +#define CTYPES_PACKED(name) struct __attribute__((packed)) name +#else +#define CTYPES_PACKED(name) struct name +#endif + +CTYPES_PACKED(packed_struct) { + int8_t i8; + int64_t i64; + long double _Complex ldc; + int32_t i32; +}; + +bool check_packed_struct(struct packed_struct *, int8_t, int64_t, long double _Complex*, int32_t); + #endif /* TEST_FUNCTIONS_H */ diff --git a/tests/test-structs/stubs/types.ml b/tests/test-structs/stubs/types.ml index 8778e347c..a12371a59 100644 --- a/tests/test-structs/stubs/types.ml +++ b/tests/test-structs/stubs/types.ml @@ -49,4 +49,11 @@ struct let v1 = field s6 "v1" int let v2 = field s6 "v2" float let () = seal s6 + + let spacked : [`packed] structure typ = structure "packed_struct" + let i8 = field spacked "i8" int8_t + let i64 = field spacked "i64" int64_t + let ldc = field spacked "ldc" complexld + let i32 = field spacked "i32" int32_t + let () = seal spacked end diff --git a/tests/test-structs/test_structs.ml b/tests/test-structs/test_structs.ml index 8146b2b74..347be28db 100644 --- a/tests/test-structs/test_structs.ml +++ b/tests/test-structs/test_structs.ml @@ -588,6 +588,29 @@ struct end end + let test_packed_structs _ = + let open M in + let check_packed_struct = + Foreign.foreign "check_packed_struct" + (ptr spacked @-> int8_t @-> int64_t @-> ptr complexld @-> int32_t @-> returning bool) + in + let vi8 = 127 in + let vi64 = 0x1234567890abcdefL in + let vldc = Complex.{ re = 0x123456789abcde. ; im = -0xfedcba9876543. } in + let vldc = ComplexL.of_complex vldc in + let vi32 = 0x12345678l in + let s = make spacked in + s @. i8 <-@ vi8; + s @. i64 <-@ vi64; + s @. ldc <-@ vldc; + s @. i32 <-@ vi32; + let pvldc = allocate complexld vldc in + assert_equal true (check_packed_struct (addr s) vi8 vi64 pvldc vi32); + assert_equal vi8 (getf s i8); + assert_equal vi64 (getf s i64); + assert_equal vldc (getf s ldc); + assert_equal vi32 (getf s i32) + end module Struct_stubs_tests = Build_struct_stub_tests(Generated_struct_bindings) @@ -663,6 +686,9 @@ let suite = "Struct tests" >::: "test adding fields to tagless structs" >:: Struct_stubs_tests.test_tagless_structs; + + "test packed structs" + >:: Struct_stubs_tests.test_packed_structs; ] From 7d02e43c70821d0c128d541cb46154d54d83b13e Mon Sep 17 00:00:00 2001 From: fdopen Date: Mon, 27 Apr 2020 18:35:49 +0200 Subject: [PATCH 2/2] use memcpy to avoid undefined behavior Stub generations also supports packed structs. The addresses are therefore not guaranteed to be properly aligned. --- src/ctypes/type_info_stubs.c | 325 +++++++++++++++++++++++++++++------ 1 file changed, 275 insertions(+), 50 deletions(-) diff --git a/src/ctypes/type_info_stubs.c b/src/ctypes/type_info_stubs.c index 2fd8386bf..d5d83a334 100644 --- a/src/ctypes/type_info_stubs.c +++ b/src/ctypes/type_info_stubs.c @@ -44,33 +44,158 @@ value ctypes_read(value prim_, value buffer_) case Ctypes_Char: b = Val_int(*(unsigned char*)buf); break; case Ctypes_Schar: b = Val_int(*(signed char *)buf); break; case Ctypes_Uchar: b = Integers_val_uint8(*(unsigned char *)buf); break; - case Ctypes_Bool: b = Val_bool(*(bool *)buf); break; - case Ctypes_Short: b = Val_int(*(short *)buf); break; - case Ctypes_Int: b = Val_int(*(int *)buf); break; - case Ctypes_Long: b = ctypes_copy_long(*(long *)buf); break; - case Ctypes_Llong: b = ctypes_copy_llong(*(long long *)buf); break; - case Ctypes_Ushort: b = ctypes_copy_ushort(*(unsigned short *)buf); break; - case Ctypes_Sint: b = ctypes_copy_sint(*(int *)buf); break; - case Ctypes_Uint: b = ctypes_copy_uint(*(unsigned int *)buf); break; - case Ctypes_Ulong: b = ctypes_copy_ulong(*(unsigned long *)buf); break; - case Ctypes_Ullong: b = ctypes_copy_ullong(*(unsigned long long *)buf); break; - case Ctypes_Size_t: b = ctypes_copy_size_t(*(size_t *)buf); break; + case Ctypes_Bool: { + bool s; + memcpy(&s,buf,sizeof(s)); + b = Val_bool(s); + break; + } + case Ctypes_Short: { + short s; + memcpy(&s, buf, sizeof(s)); + b = Val_int(s); + break; + } + case Ctypes_Int: { + int s; + memcpy(&s, buf, sizeof(s)); + b = Val_int(s); + break; + } + case Ctypes_Long: { + long s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_long(s); + break; + } + case Ctypes_Llong: { + long long s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_llong(s); + break; + } + case Ctypes_Ushort: { + unsigned short s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_ushort(s); + break; + } + case Ctypes_Sint: { + int s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_sint(s); + break; + } + case Ctypes_Uint: { + unsigned int s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_uint(s); + break; + } + case Ctypes_Ulong: { + unsigned long s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_ulong(s); + break; + } + case Ctypes_Ullong: { + unsigned long long s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_ullong(s); + break; + } + case Ctypes_Size_t: { + size_t s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_size_t(s); + break; + } case Ctypes_Int8_t: b = Val_int(*(int8_t *)buf); break; - case Ctypes_Int16_t: b = Val_int(*(int16_t *)buf); break; - case Ctypes_Int32_t: b = caml_copy_int32(*(int32_t *)buf); break; - case Ctypes_Int64_t: b = caml_copy_int64(*(int64_t *)buf); break; + case Ctypes_Int16_t: { + int16_t s; + memcpy(&s, buf, sizeof(s)); + b = Val_int(s); + break; + } + case Ctypes_Int32_t: { + int32_t s; + memcpy(&s, buf, sizeof(s)); + b = caml_copy_int32(s); + break; + } + case Ctypes_Int64_t: { + int64_t s; + memcpy(&s, buf, sizeof(s)); + b = caml_copy_int64(s); + break; + } case Ctypes_Uint8_t: b = Integers_val_uint8(*(uint8_t *)buf); break; - case Ctypes_Uint16_t: b = Integers_val_uint16(*(uint16_t *)buf); break; - case Ctypes_Uint32_t: b = integers_copy_uint32(*(uint32_t *)buf); break; - case Ctypes_Uint64_t: b = integers_copy_uint64(*(uint64_t *)buf); break; - case Ctypes_Camlint: b = Val_long(*(intnat *)buf); break; - case Ctypes_Nativeint: b = caml_copy_nativeint(*(intnat *)buf); break; - case Ctypes_Float: b = caml_copy_double(*(float *)buf); break; - case Ctypes_Double: b = caml_copy_double(*(double *)buf); break; - case Ctypes_LDouble: b = ctypes_copy_ldouble(*(long double *)buf); break; - case Ctypes_Complex32: b = ctypes_copy_float_complex(*(float _Complex *)buf); break; - case Ctypes_Complex64: b = ctypes_copy_double_complex(*(double _Complex *)buf); break; - case Ctypes_Complexld: b = ctypes_copy_ldouble_complex(*(long double _Complex *)buf); break; + case Ctypes_Uint16_t: { + uint16_t s; + memcpy(&s, buf, sizeof(s)); + b = Integers_val_uint16(s); + break; + } + case Ctypes_Uint32_t: { + uint32_t s; + memcpy(&s, buf, sizeof(s)); + b = integers_copy_uint32(s); + break; + } + case Ctypes_Uint64_t: { + uint64_t s; + memcpy(&s, buf, sizeof(s)); + b = integers_copy_uint64(s); + break; + } + case Ctypes_Camlint: { + intnat s; + memcpy(&s, buf, sizeof(s)); + b = Val_long(s); + break; + } + case Ctypes_Nativeint: { + intnat s; + memcpy(&s, buf, sizeof(s)); + b = caml_copy_nativeint(s); + break; + } + case Ctypes_Float: { + float s; + memcpy(&s, buf, sizeof(s)); + b = caml_copy_double(s); + break; + } + case Ctypes_Double: { + double s; + memcpy(&s, buf, sizeof(s)); + b = caml_copy_double(s); + break; + } + case Ctypes_LDouble: { + long double s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_ldouble(s); + break; + } + case Ctypes_Complex32: { + float _Complex s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_float_complex(s); + break; + } + case Ctypes_Complex64: { + double _Complex s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_double_complex(s); + break; + } + case Ctypes_Complexld: { + long double _Complex s; + memcpy(&s, buf, sizeof(s)); + b = ctypes_copy_ldouble_complex(s); + break; + } default: assert(0); } @@ -88,33 +213,133 @@ value ctypes_write(value prim_, value v, value buffer_) case Ctypes_Char: *(unsigned char *)buf = Int_val(v); break; case Ctypes_Schar: *(signed char *)buf = Int_val(v); break; case Ctypes_Uchar: *(unsigned char *)buf = Uint8_val(v); break; - case Ctypes_Bool: *(bool *)buf = Bool_val(v); break; - case Ctypes_Short: *(short *)buf = Int_val(v); break; - case Ctypes_Int: *(int *)buf = Int_val(v); break; - case Ctypes_Long: *(long *)buf = ctypes_long_val(v); break; - case Ctypes_Llong: *(long long *)buf = ctypes_llong_val(v); break; - case Ctypes_Ushort: *(unsigned short *)buf = ctypes_ushort_val(v); break; - case Ctypes_Sint: *(int *)buf = ctypes_sint_val(v); break; - case Ctypes_Uint: *(unsigned int *)buf = ctypes_uint_val(v); break; - case Ctypes_Ulong: *(unsigned long *)buf = ctypes_ulong_val(v); break; - case Ctypes_Ullong: *(unsigned long long *)buf = ctypes_ullong_val(v); break; - case Ctypes_Size_t: *(size_t *)buf = ctypes_size_t_val(v); break; + case Ctypes_Bool: { + bool s = Bool_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Short: { + short s = Int_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Int: { + int s = Int_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Long: { + long s = ctypes_long_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Llong: { + long long s = ctypes_llong_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Ushort: { + unsigned short s = ctypes_ushort_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Sint: { + int s = ctypes_sint_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Uint: { + unsigned int s = ctypes_uint_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Ulong: { + unsigned long s = ctypes_ulong_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Ullong: { + unsigned long long s = ctypes_ullong_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Size_t: { + size_t s = ctypes_size_t_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } case Ctypes_Int8_t: *(int8_t *)buf = Int_val(v); break; - case Ctypes_Int16_t: *(int16_t *)buf = Int_val(v); break; - case Ctypes_Int32_t: *(int32_t *)buf = Int32_val(v); break; - case Ctypes_Int64_t: *(int64_t *)buf = Int64_val(v); break; + case Ctypes_Int16_t: { + int16_t s = Int_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Int32_t: { + int32_t s = Int32_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Int64_t: { + int64_t s = Int64_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } case Ctypes_Uint8_t: *(uint8_t *)buf = Uint8_val(v); break; - case Ctypes_Uint16_t: *(uint16_t *)buf = Uint16_val(v); break; - case Ctypes_Uint32_t: *(uint32_t *)buf = Uint32_val(v); break; - case Ctypes_Uint64_t: *(uint64_t *)buf = Uint64_val(v); break; - case Ctypes_Camlint: *(intnat *)buf = Long_val(v); break; - case Ctypes_Nativeint: *(intnat *)buf = Nativeint_val(v); break; - case Ctypes_Float: *(float *)buf = Double_val(v); break; - case Ctypes_Double: *(double *)buf = Double_val(v); break; - case Ctypes_LDouble: *(long double *)buf = ctypes_ldouble_val(v); break; - case Ctypes_Complex32: *(float _Complex *)buf = ctypes_float_complex_val(v); break; - case Ctypes_Complex64: *(double _Complex *)buf = ctypes_double_complex_val(v); break; - case Ctypes_Complexld: *(long double _Complex *)buf = ctypes_ldouble_complex_val(v); break; + case Ctypes_Uint16_t: { + uint16_t s = Uint16_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Uint32_t: { + uint32_t s = Uint32_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Uint64_t: { + uint64_t s = Uint64_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Camlint: { + intnat s = Long_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Nativeint: { + intnat s = Nativeint_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Float: { + float s = Double_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Double: { + double s = Double_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_LDouble: { + long double s = ctypes_ldouble_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Complex32: { + float _Complex s = ctypes_float_complex_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Complex64: { + double _Complex s = ctypes_double_complex_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } + case Ctypes_Complexld: { + long double _Complex s = ctypes_ldouble_complex_val(v); + memcpy(buf, &s, sizeof(s)); + break; + } default: assert(0); }