Allow the Esperanto support for lwt

.github/workflows/esperanto.yml

@@ -0,0 +1,102 @@
+name: Esperanto support
+on: [ push ]
+jobs:
+  test:
+    strategy:
+      matrix:
+        operating-system: [ ubuntu-latest ]
+        ocaml-version: [ "4.13.1", "4.14.0" ]
+        local-packages:
+          - |
+            *.opam
+            !lwt_domain.opam
+    runs-on: ${{ matrix.operating-system }}
+    steps:
+    - uses: actions/checkout@v2
+    - uses: ocaml/setup-ocaml@v2
+      with:
+        ocaml-compiler: ${{ matrix.ocaml-version }}
+        opam-local-packages: ${{ matrix.local-packages }}
+    - name: Fix binfmt and Cosmopolitan
+      run: sudo sh -c "echo ':APE:M::MZqFpD::/bin/sh:' >/proc/sys/fs/binfmt_misc/register"
+    - name: Install Esperanto, Dune & ocamlfind
+      run: opam install esperanto.0.0.3 dune ocamlfind
+    - name: Install opam-monorepo
+      run: opam install opam-monorepo
+    - name: Add opam-monorepo overlays
+      run: opam repo add dune-universe git+https://github.com/dune-universe/opam-overlays.git
+    - name: Example with lwt & esperanto
+      run: |
+        mkdir esperanto-example
+        cd esperanto-example
+        cat >dune-workspace <<EOF
+        (lang dune 2.0)
+        (context (default))
+        (context
+         (default
+          (name esperanto)
+          (toolchain esperanto)
+          (host default)))
+        EOF
+        cat >dune-project <<EOF
+        (lang dune 2.0)
+        EOF
+        cat >cat.ml <<EOF
+        open Lwt.Infix
+
+        let rec full_write fd buf off len =
+          Lwt_unix.write fd buf off len >>= fun len' ->
+          if len - len' > 0
+          then full_write fd buf (off + len') (len - len')
+          else Lwt.return_unit
+
+        let tmp = Bytes.create 0x1000
+
+        let rec cat () =
+          Lwt.catch begin fun () ->
+          Lwt_unix.read Lwt_unix.stdin tmp 0 (Bytes.length tmp) >>= fun len ->
+          match len with
+          | 0 -> Lwt.return_unit
+          | len -> full_write Lwt_unix.stdout tmp 0 len >>= cat
+        end @@ function
+        | End_of_file -> Lwt.return_unit
+        | exn -> raise exn
+
+        let () = Lwt_main.run (cat ())
+        EOF
+        cat >dune <<EOF
+        (executable
+         (name cat)
+         (libraries lwt.unix))
+        EOF
+        cat >cat.opam <<EOF
+        opam-version: "2.0"
+        name:         "cat"
+        maintainer:   [ "Romain Calascibetta <[email protected]>" ]
+        authors:      [ "Romain Calascibetta <[email protected]>" ]
+        homepage:     "https://github.com/dinosaure/esperanto"
+        bug-reports:  "https://github.com/dinosaure/esperanto/issues"
+        dev-repo:     "git+https://github.com/dinosaure/esperanto"
+        doc:          "https://dinosaure.github.io/esperanto/"
+        license:      "MIT"
+        synopsis:     "The cat.com tool produced by esperanto"
+        description:  "The cat.com tool produced by esperanto"
+
+        build: [
+          [ "dune" "build" "-p" name "-j" jobs ]
+        ]
+        install:  [
+          [ "dune" "install" "-p" name ] {with-test}
+        ]
+
+        depends: [
+          "ocaml"           {>= "4.12.0"}
+          "dune"            {>= "2.8.0"}
+          "lwt"
+        ]
+        EOF
+        opam monorepo lock --ocaml-version  ${{ matrix.ocaml-version }}
+        opam monorepo pull
+        opam exec -- dune build -x esperanto ./cat.exe
+        objcopy -S -O binary _build/default.esperanto/cat.exe cat.com
+        ./cat.com < cat.ml

src/unix/config/discover.ml

@@ -160,6 +160,8 @@ sig
 
   val ws2_32_lib : Configurator.t -> unit
 
+  val set_c_flags : string list -> unit
+  val set_link_flags : string list -> unit
   val c_flags : unit -> string list
   val link_flags : unit -> string list
   val add_link_flags : string list -> unit
@@ -249,14 +251,19 @@ struct
 
       | None ->
         try
-          let path =
+          let _path =
             List.find
               (fun path -> Sys.file_exists (path // "include" // header))
               (Lazy.force search_paths)
           in
+          (* NOTE: for the cross-compilation sake, we should not arbitrarily
+           * include ([-I]) some paths which can clash some cross-compilation's
+           * definitions with host's definitions. The default case about flags
+           * should always be less than more - and we should put these flags
+           * only we really require them. *)
           extend
-            ["-I" ^ (path // "include")]
-            ["-L" ^ (path // "lib"); "-l" ^ library]
+            [] (* ["-I" ^ (path // "include")] *)
+            [] (* ["-L" ^ (path // "lib"); "-l" ^ library] *)
         with Not_found ->
           ()
 
@@ -268,6 +275,9 @@ struct
       else
         extend unicode ["-lws2_32"]
 
+  let set_c_flags lst = c_flags := lst
+  let set_link_flags lst = link_flags := lst
+
   let c_flags () =
     !c_flags
 
@@ -368,15 +378,19 @@ struct
         Output.{name = feature.macro_name; found}
     end
 
-  let compiles ?(werror = false) ?(link_flags = []) context code =
-    let c_flags = C_library_flags.c_flags () in
+  let compiles ?(werror = false) ?c_flags ?link_flags context code =
+    let c_flags = match c_flags with
+      | None -> C_library_flags.c_flags ()
+      | Some c_flags -> c_flags in
     let c_flags =
       if werror then
         "-Werror"::c_flags
       else
         c_flags
     in
-    let link_flags = link_flags @ (C_library_flags.link_flags ()) in
+    let link_flags = match link_flags with
+      | None -> C_library_flags.link_flags ()
+      | Some link_flags -> link_flags in
     Configurator.c_test context ~c_flags ~link_flags code
     |> fun result -> Some result
 
@@ -390,6 +404,76 @@ struct
     | Some true -> None
     | _ -> k ()
 
+  let () = feature {
+    pretty_name = "pthread";
+    macro_name = "HAVE_PTHREAD";
+    detect = fun context ->
+      if !Arguments.use_pthread = Some false then
+        None
+      else begin
+        skip_if_windows context @@ fun () ->
+        let code = {|
+          #include <pthread.h>
+
+          int main()
+          {
+              pthread_create(1, 1, 1, 1);
+              return 0;
+          }
+        |}
+        in
+        (* To clarify the semantic of the recognition of [pthread]:
+           1) [pthread] can be _standalone_ (included in the standard library)
+              depending on the C compiler
+             1.1) A restrictive context (such as a cross-compilation context)
+                  requires, at least, [-lpthread] but [-I] and [-L] can
+                  disturb the compilation between the host's [pthread] and the
+                  cross-compiled [pthread]. We test above all and for all this
+                  tricky context with **only one** flag [-lpthread]
+             1.2) On some platforms, if [pthread] is standalone, the linker
+                  fails when we link with [-lpthread]. So we test our code
+                  with **default** flags (such as [-I/usr/include] and
+                  [-L/usr/lib]) and **without** [-pthread]
+           2) On Android, compiling without [-lpthread] is the only way to link
+              with [pthread], and we don't to search for [pthread.a], because
+              if we find it, it is likely the host's [pthread]
+           3) We finally retest our code with [-lpthread] and basic [-L] and
+              [-I] flags (from the host system)
+
+           NOTE(dinosaure):
+           - 2) and 1.1) should be merged, we definitely should try to compile
+           the code **without any flags** and see results - by this way, we
+           consider that the _toolchain_ leads us about where is
+           [pthread].
+           - 3) is too ~vague~ and obviously works but it's difficult to really
+           understand which [pthread] we really use.
+           - A question remains about priorities: do we want to prioritize
+           the [dune]'s context or do we prefer a compilation for the host
+           system first?
+           - In anyway, [discover.exe] should be less pervasives (no [ref]
+           about flags) and more strict and reproducible *)
+        match (* 1.2 *) compiles context code,
+              (* 1.1 *) compiles ~c_flags:[] ~link_flags:[ "-lpthread" ] context code with
+        | _, Some true (* prioritize [dune]'s context and cross-compilation *) ->
+          C_library_flags.set_c_flags [] ;
+          C_library_flags.set_link_flags [ "-lpthread" ] ;
+          Some true
+        | Some true, _ -> Some true
+        | _no ->
+          if (* 2 *) !Arguments.android_target = Some true then
+            Some false
+          else begin
+            match (* 3 *) compiles context code ~link_flags:["-lpthread"] with
+            | Some true ->
+              C_library_flags.add_link_flags ["-lpthread"];
+              Some true
+            | _ ->
+              C_library_flags.detect context ~library:"pthread";
+              compiles context code
+          end
+      end
+  }
+
   let () = feature {
     pretty_name = "libev";
     macro_name = "HAVE_LIBEV";
@@ -431,61 +515,17 @@ struct
           }
         |}
         in
-        match compiles context code ~link_flags:["-lev"] with
+        match compiles context code ~link_flags:("-lev" :: C_library_flags.link_flags ()) with
         | Some true ->
           C_library_flags.add_link_flags ["-lev"];
           Some true
         | _ ->
+          (* C_library_flags.add_link_flags ["-lev"]; *)
           C_library_flags.detect context ~library:"ev";
           compiles context code
       end
   }
 
-  let () = feature {
-    pretty_name = "pthread";
-    macro_name = "HAVE_PTHREAD";
-    detect = fun context ->
-      if !Arguments.use_pthread = Some false then
-        None
-      else begin
-        skip_if_windows context @@ fun () ->
-        let code = {|
-          #include <pthread.h>
-
-          int main()
-          {
-              pthread_create(0, 0, 0, 0);
-              return 0;
-          }
-        |}
-        in
-        (* On some platforms, pthread is included in the standard library, but
-           linking with -lpthread fails. So, try to link the test code without
-           any flags first.
-
-           If that fails and we are not targeting Android, try to link with
-           -lpthread. If *that* fails, search for libpthread in the filesystem.
-
-           When targeting Android, compiling without -lpthread is the only way
-           to link with pthread, and we don't to search for libpthread, because
-           if we find it, it is likely the host's libpthread. *)
-        match compiles context code with
-        | Some true -> Some true
-        | no ->
-          if !Arguments.android_target = Some true then
-            no
-          else begin
-            match compiles context code ~link_flags:["-lpthread"] with
-            | Some true ->
-              C_library_flags.add_link_flags ["-lpthread"];
-              Some true
-            | _ ->
-              C_library_flags.detect context ~library:"pthread";
-              compiles context code
-          end
-      end
-  }
-
   let () = feature {
     pretty_name = "eventfd";
     macro_name = "HAVE_EVENTFD";
@@ -516,6 +556,7 @@ struct
             struct msghdr msg;
             msg.msg_controllen = 0;
             msg.msg_control = 0;
+            unsigned char *data = CMSG_DATA(CMSG_FIRSTHDR(&msg));
             return 0;
         }
       |}

src/unix/unix_c/unix_access_job.c

@@ -33,21 +33,21 @@
    | Converters                                                      |
    +-----------------------------------------------------------------+ */
 
-/* Table mapping constructors of ocaml type Unix.access_permission to C values. */
-static int access_permission_table[] = {
-  /* Constructor R_OK. */
-  R_OK,
-  /* Constructor W_OK. */
-  W_OK,
-  /* Constructor X_OK. */
-  X_OK,
-  /* Constructor F_OK. */
-  F_OK
-};
-
 /* Convert ocaml values of type Unix.access_permission to a C int. */
 static int int_of_access_permissions(value list)
 {
+  /* Table mapping constructors of ocaml type Unix.access_permission to C values. */
+  int access_permission_table[] = {
+    /* Constructor R_OK. */
+    R_OK,
+    /* Constructor W_OK. */
+    W_OK,
+    /* Constructor X_OK. */
+    X_OK,
+    /* Constructor F_OK. */
+    F_OK
+  };
+
   int result = 0;
   while (list != Val_emptylist) {
     result |= access_permission_table[Int_val(Field(list, 0))];

src/unix/unix_c/unix_get_network_information_utils.c

@@ -139,16 +139,12 @@ value alloc_host_entry(struct hostent *entry)
     res = caml_alloc_small(4, 0);
     Field(res, 0) = name;
     Field(res, 1) = aliases;
-    switch (entry->h_addrtype) {
-        case PF_UNIX:
+    if (entry->h_addrtype == PF_UNIX) {
             Field(res, 2) = Val_int(0);
-            break;
-        case PF_INET:
+    } else if (entry->h_addrtype == PF_INET) {
             Field(res, 2) = Val_int(1);
-            break;
-        default: /*PF_INET6 */
+    } else {
             Field(res, 2) = Val_int(2);
-            break;
     }
     Field(res, 3) = addr_list;
     End_roots();

src/unix/unix_c/unix_get_pw_gr_nam_id_job.c

@@ -20,7 +20,11 @@
 
 #include "lwt_unix.h"
 
-#if !defined(__ANDROID__)
+/* NOTE: [__ESPERANTO__] is defined by the cross-compiler if we compile into
+ * the [esperanto] context (with [arch-esperanto-none-static-cc]). Otherwise,
+ * nobody should define this macro. The code above can not be compiled with
+ * Esperanto/Cosmopolitan due to missing [_SC*] macros. */
+#if !defined(__ANDROID__) && !defined(__ESPERANTO__)
 
 static value alloc_passwd_entry(struct passwd *entry)
 {