diff --git a/Makefile b/Makefile index 084d03f2..8cdfdc17 100644 --- a/Makefile +++ b/Makefile @@ -10,6 +10,10 @@ watch : test : dune runtest --no-buffer --force +.PHONY : test-watch +test-watch : + dune runtest --no-buffer --force --watch + .PHONY : examples examples : dune build \ diff --git a/src/FS_event.mli b/src/FS_event.mli index cf0a3ec8..c7c738c1 100644 --- a/src/FS_event.mli +++ b/src/FS_event.mli @@ -43,7 +43,7 @@ val start : ?recursive:bool -> t -> string -> - ((string * (Event.t list), Error.t) result -> unit) -> + ((string option * (Event.t list), Error.t) result -> unit) -> unit (** Starts the handle and watches the given path for changes. diff --git a/src/c/helpers.c b/src/c/helpers.c index 7fcd8b67..46d710ef 100644 --- a/src/c/helpers.c +++ b/src/c/helpers.c @@ -142,10 +142,14 @@ static void luv_fs_event_trampoline( { caml_acquire_runtime_system(); CAMLparam0(); - CAMLlocal1(callback); + CAMLlocal2(callback, option); GET_HANDLE_CALLBACK(LUV_GENERIC_CALLBACK); + if (filename == NULL) + option = Val_none; + else + option = caml_alloc_some(caml_copy_string(filename)); caml_callback3( - callback, caml_copy_string(filename), Val_int(events), Val_int(status)); + callback, option, Val_int(events), Val_int(status)); CAMLdrop; caml_release_runtime_system(); } @@ -641,6 +645,22 @@ int luv_os_uname(char *buffer) +// String conversion functions. + +size_t luv_utf16_length_as_wtf8(const char *utf16, ssize_t utf16_len) +{ + return uv_utf16_length_as_wtf8((const uint16_t*)utf16, utf16_len); +} + +int luv_utf16_to_wtf8( + const char *utf16, ssize_t utf16_len, char **wtf8_ptr, + size_t *wtf8_len_ptr) +{ + uv_utf16_to_wtf8((const uint16_t*)utf16, utf16_len, wtf8_ptr, wtf8_len_ptr); +} + + + // Other helpers. char* luv_version_suffix() diff --git a/src/c/helpers.h b/src/c/helpers.h index f73e32fb..61fb1f1f 100644 --- a/src/c/helpers.h +++ b/src/c/helpers.h @@ -188,6 +188,20 @@ int luv_os_uname(char *buffer); +// String conversion functions. These are wrapped because it is convenient to +// use Ctypes to pass OCaml strings directly to C code, but the Ctypes type +// combinator for that purpose only compiles against C arguments of types such +// as char*, and not uint16_t*. So these helpers add the necessary casts to +// satisfy Ctypes. + +size_t luv_utf16_length_as_wtf8(const char *utf16, ssize_t utf16_len); + +int luv_utf16_to_wtf8( + const char *utf16, ssize_t utf16_len, char **wtf8_ptr, + size_t *wtf8_len_ptr); + + + // Miscellaneous helpers - other things that are easiest to do in C. // Ctypes.constant can't bind a char*, so we return it instead. diff --git a/src/c/luv_c_function_descriptions.ml b/src/c/luv_c_function_descriptions.ml index f01a9f97..c152e641 100644 --- a/src/c/luv_c_function_descriptions.ml +++ b/src/c/luv_c_function_descriptions.ml @@ -1913,4 +1913,31 @@ struct foreign "uv_metrics_info" (ptr Types.Loop.t @-> ptr Types.Metrics.t @-> returning int) end + + module String_ = + struct + let utf16_length_as_wtf8 = + foreign "luv_utf16_length_as_wtf8" + (string @-> PosixTypes.ssize_t @-> returning size_t) + + let utf16_to_wtf8 = + foreign "luv_utf16_to_wtf8" + (string @-> + PosixTypes.ssize_t @-> + ptr (ptr char) @-> + ptr size_t @-> + returning error_code) + + let wtf8_length_as_utf16 = + foreign "uv_wtf8_length_as_utf16" + (string @-> returning PosixTypes.ssize_t) + + let wtf8_to_utf16 = + foreign "uv_wtf8_to_utf16" + (string @-> ptr uint16_t @-> size_t @-> returning void) + + let free = + foreign "free" + (ptr void @-> returning void) + end end diff --git a/src/c/shims.h b/src/c/shims.h index dc742127..0ccf8029 100644 --- a/src/c/shims.h +++ b/src/c/shims.h @@ -746,3 +746,27 @@ #define UV_EUNATCH 0x7242424 #endif + +#if UV_VERSION_MAJOR == 1 && UV_VERSION_MINOR < 47 + size_t uv_utf16_length_as_wtf8(const uint16_t *utf16, ssize_t utf16_len) + { + return ENOSYS; + } + + int uv_utf16_to_wtf8( + const uint16_t *utf16, ssize_t utf16_len, char **wtf8_ptr, + size_t *wtf8_len_ptr) + { + return ENOSYS; + } + + ssize_t uv_wtf8_length_as_utf16(const char *wtf8) + { + return ENOSYS; + } + + void uv_wtf8_to_utf16(const char *utf8, uint16_t *utf16, size_t utf16_len) + { + abort(); + } +#endif diff --git a/src/c/vendor/configure/commit-hash b/src/c/vendor/configure/commit-hash index 38d66713..8417f27b 100644 --- a/src/c/vendor/configure/commit-hash +++ b/src/c/vendor/configure/commit-hash @@ -1 +1 @@ -f0bb7e40f0508bedf6fad33769b3f87bb8aedfa6 +be6b81a352d17513c95be153afcb3148f1a451cd diff --git a/src/c/vendor/configure/configure b/src/c/vendor/configure/configure index 5c44ac37..517b0857 100755 --- a/src/c/vendor/configure/configure +++ b/src/c/vendor/configure/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for libuv 1.46.0. +# Generated by GNU Autoconf 2.71 for libuv 1.47.0. # # Report bugs to . # @@ -618,8 +618,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='libuv' PACKAGE_TARNAME='libuv' -PACKAGE_VERSION='1.46.0' -PACKAGE_STRING='libuv 1.46.0' +PACKAGE_VERSION='1.47.0' +PACKAGE_STRING='libuv 1.47.0' PACKAGE_BUGREPORT='https://github.com/libuv/libuv/issues' PACKAGE_URL='' @@ -1390,7 +1390,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures libuv 1.46.0 to adapt to many kinds of systems. +\`configure' configures libuv 1.47.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1461,7 +1461,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of libuv 1.46.0:";; + short | recursive ) echo "Configuration of libuv 1.47.0:";; esac cat <<\_ACEOF @@ -1576,7 +1576,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -libuv configure 1.46.0 +libuv configure 1.47.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -1832,7 +1832,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by libuv $as_me 1.46.0, which was +It was created by libuv $as_me 1.47.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3169,7 +3169,7 @@ fi # Define the identity of the package. PACKAGE='libuv' - VERSION='1.46.0' + VERSION='1.47.0' printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h @@ -15042,7 +15042,7 @@ fi case $host_os in mingw*) - LIBS="$LIBS -lws2_32 -lpsapi -liphlpapi -lshell32 -luserenv -luser32 -ldbghelp -lole32 -luuid" + LIBS="$LIBS -lws2_32 -lpsapi -liphlpapi -lshell32 -luserenv -luser32 -ldbghelp -lole32 -luuid -lshell32" ;; esac case $host_os in @@ -15741,7 +15741,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by libuv $as_me 1.46.0, which was +This file was extended by libuv $as_me 1.47.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -15804,7 +15804,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -libuv config.status 1.46.0 +libuv config.status 1.47.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/src/c/vendor/libuv b/src/c/vendor/libuv index f0bb7e40..be6b81a3 160000 --- a/src/c/vendor/libuv +++ b/src/c/vendor/libuv @@ -1 +1 @@ -Subproject commit f0bb7e40f0508bedf6fad33769b3f87bb8aedfa6 +Subproject commit be6b81a352d17513c95be153afcb3148f1a451cd diff --git a/src/feature/detect_features.ml b/src/feature/detect_features.ml index f1a9c656..b21d6dfe 100644 --- a/src/feature/detect_features.ml +++ b/src/feature/detect_features.ml @@ -303,6 +303,7 @@ let () = needs 37 "udp_recvmmsg" "See {!Luv.UDP.init}."; needs 32 "udp_set_source_membership" "See {!Luv.UDP.set_source_membership}."; needs 39 "udp_using_recvmmsg" "See {!Luv.UDP.using_recvmmsg}."; + needs 47 "utf_16" "See {!Luv.String}."; let mli_channel = open_out mli in Buffer.contents mli_buffer |> output_string mli_channel; diff --git a/src/index.mld b/src/index.mld index 89c3c149..5ba1ba1b 100644 --- a/src/index.mld +++ b/src/index.mld @@ -92,5 +92,6 @@ presented in the user guide. - {!Luv.Prepare} — pre-I/O callbacks - {!Luv.Check} — post-I/O callbacks - {!Luv.Idle} — per-iteration callbacks +- {!Luv.String} — UTF-16 manipulation for Windows - {!Luv.Version} — libuv version - {!Luv.Require} — feature checks diff --git a/src/luv.ml b/src/luv.ml index 6b6b139b..b4b261a2 100644 --- a/src/luv.ml +++ b/src/luv.ml @@ -64,5 +64,6 @@ module Env = Env module Time = Time module Random = Random module Metrics = Metrics +module String = String_ module Require = Require module Unix = Luv_unix diff --git a/src/string_.ml b/src/string_.ml new file mode 100644 index 00000000..2126b7bb --- /dev/null +++ b/src/string_.ml @@ -0,0 +1,57 @@ +(* This file is part of Luv, released under the MIT license. See LICENSE.md for + details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *) + + + +let utf16_length_as_wtf8 s = + let result = + C.Functions.String_.utf16_length_as_wtf8 + s + (PosixTypes.Ssize.of_int (String.length s / 2)) + |> Unsigned.Size_t.to_int + in + if result < 0 then + Printf.ksprintf + failwith "Luv internal error: utf16_length_as_wtf8 error code %i;%s" + result "\nCheck your libuv version; 1.47.0 or higher required."; + result + +let utf16_to_wtf8 s = + let wtf8 = Ctypes.(allocate (ptr char) (coerce (ptr void) (ptr char) null)) in + let wtf8_length = Ctypes.(allocate size_t) Unsigned.Size_t.zero in + let error_code = + C.Functions.String_.utf16_to_wtf8 + s + (PosixTypes.Ssize.of_int (String.length s / 2)) + wtf8 + wtf8_length + in + if error_code <> 0 then + Printf.ksprintf + failwith "Luv internal error: utf16_to_wtf8 error code %i;%s" error_code + "\nCheck your libuv version; 1.47.0 or higher required."; + let wtf8 = Ctypes.(!@ wtf8) in + let wtf8_length = Ctypes.(!@ wtf8_length) |> Unsigned.Size_t.to_int in + let s = Ctypes.string_from_ptr wtf8 ~length:wtf8_length in + C.Functions.String_.free Ctypes.(coerce (ptr char) (ptr void) wtf8); + s + +let wtf8_length_as_utf16 s = + let result = + C.Functions.String_.wtf8_length_as_utf16 s + |> PosixTypes.Ssize.to_int + in + if result < 0 then + Printf.ksprintf + failwith "Luv internal error: wtf8_length_as_utf16 error code %i;%s" + result "\nCheck your libuv version; 1.47.0 or higher required."; + result + +let wtf8_to_utf16 s = + let utf16_length = wtf8_length_as_utf16 s in + let utf16 = Ctypes.(allocate_n uint16_t) ~count:utf16_length in + C.Functions.String_.wtf8_to_utf16 + s utf16 (Unsigned.Size_t.of_int utf16_length); + utf16 + |> Ctypes.(coerce (ptr uint16_t) (ptr char)) + |> Ctypes.string_from_ptr ~length:((utf16_length - 1) * 2) diff --git a/src/string_.mli b/src/string_.mli new file mode 100644 index 00000000..f9d7988b --- /dev/null +++ b/src/string_.mli @@ -0,0 +1,36 @@ +(* This file is part of Luv, released under the MIT license. See LICENSE.md for + details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *) + + + +val utf16_length_as_wtf8 : string -> int +(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_utf16_length_as_wtf8} + [uv_utf16_length_as_wtf8]}. + + Requires Luv 0.5.13 and libuv 1.47.0. + + {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *) + +val utf16_to_wtf8 : string -> string +(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_utf16_to_wtf8} + [uv_utf16_to_wtf8]}. + + Requires Luv 0.5.13 and libuv 1.47.0. + + {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *) + +val wtf8_length_as_utf16 : string -> int +(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_wtf8_length_as_utf16} + [uv_wtf8_length_as_utf16]}. + + Requires Luv 0.5.13 and libuv 1.47.0. + + {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *) + +val wtf8_to_utf16 : string -> string +(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_wtf8_to_utf16} + [uv_wtf8_to_utf16]}. + + Requires Luv 0.5.13 and libuv 1.47.0. + + {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *) diff --git a/test/string_.ml b/test/string_.ml new file mode 100644 index 00000000..8d6993a7 --- /dev/null +++ b/test/string_.ml @@ -0,0 +1,28 @@ +(* This file is part of Luv, released under the MIT license. See LICENSE.md for + details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *) + + + +let tests = [ + "string", [ + "utf16_length_as_wtf8", `Quick, begin fun () -> + Luv.String.utf16_length_as_wtf8 "f\x00\xBB\x03" + |> Alcotest.(check int) "length" 3 + end; + + "utf16_to_wtf8", `Quick, begin fun () -> + Luv.String.utf16_to_wtf8 "f\x00\xBB\x03" + |> Alcotest.(check string) "value" "fλ" + end; + + "wtf8_length_as_utf16", `Quick, begin fun () -> + Luv.String.wtf8_length_as_utf16 "fλ" + |> Alcotest.(check int) "length" 3 + end; + + "wtf8_to_utf16", `Quick, begin fun () -> + Luv.String.wtf8_to_utf16 "fλ" + |> Alcotest.(check string) "value" "f\x00\xBB\x03" + end; + ] +] diff --git a/test/tester.ml b/test/tester.ml index eb9cf66d..09bb394d 100644 --- a/test/tester.ml +++ b/test/tester.ml @@ -24,4 +24,5 @@ let () = DNS.tests; Thread_.tests; Misc.tests; + String_.tests; ]) diff --git a/test/version.ml b/test/version.ml index fde18659..935ea4c2 100644 --- a/test/version.ml +++ b/test/version.ml @@ -9,7 +9,7 @@ let tests = [ Alcotest.(check int) "number" 1 Luv.Version.major); "minor", `Quick, (fun () -> - Alcotest.(check int) "number" 46 Luv.Version.minor); + Alcotest.(check int) "number" 47 Luv.Version.minor); "patch", `Quick, (fun () -> Alcotest.(check int) "number" 0 Luv.Version.patch); @@ -21,12 +21,12 @@ let tests = [ Alcotest.(check string) "suffix" "" Luv.Version.suffix); "hex", `Quick, (fun () -> - Alcotest.(check int) "number" 0x012E00 Luv.Version.hex); + Alcotest.(check int) "number" 0x012F00 Luv.Version.hex); "version", `Quick, (fun () -> - Alcotest.(check int) "number" 0x012E00 (Luv.Version.version ())); + Alcotest.(check int) "number" 0x012F00 (Luv.Version.version ())); "string", `Quick, (fun () -> - Alcotest.(check string) "value" "1.46.0" (Luv.Version.string ())); + Alcotest.(check string) "value" "1.47.0" (Luv.Version.string ())); ] ]