lib_eio/core/fiber.ml

@@ -150,8 +150,8 @@ let any_gen ~return ~combine fs =
       )
   in
   match !r, Cancel.get_error parent_c with
-  | OK r, _ -> r
+  | OK r, None -> r
-  | New, Some ex -> raise ex
+  | (OK _ | New), Some ex -> raise ex
   | Ex (ex, bt), None -> Printexc.raise_with_backtrace ex bt
   | Ex ex1, Some ex2 ->
     let bt2 = Printexc.get_raw_backtrace () in

lib_eio_linux/tests/test.ml

@@ -213,37 +213,35 @@ let test_signal_race () =
 
 let test_alloc_fixed_or_wait () =
   Eio_linux.run ~n_blocks:1 @@ fun _env ->
-  match Eio_linux.Low_level.alloc_fixed_or_wait () with
+  let block = Eio_linux.Low_level.alloc_fixed_or_wait () in
-  | exception (Failure "No fixed buffer available") [@warning "-52"] -> Alcotest.skip ()
+  (* We have to wait for the block, but get cancelled while waiting. *)
-  | block ->
+  begin
-    (* We have to wait for the block, but get cancelled while waiting. *)
+    try
-    begin
+      Fiber.both
-      try
+        (fun () -> ignore (Eio_linux.Low_level.alloc_fixed_or_wait () : Uring.Region.chunk))
-        Fiber.both
+        (fun () -> raise Exit);
-          (fun () -> ignore (Eio_linux.Low_level.alloc_fixed_or_wait () : Uring.Region.chunk))
+    with Exit -> ()
-          (fun () -> raise Exit);
+  end;
-      with Exit -> ()
+  (* We have to wait for the block, and get it when the old one is freed. *)
-    end;
+  Fiber.both
-    (* We have to wait for the block, and get it when the old one is freed. *)
+    (fun () ->
-    Fiber.both
+       let x = Eio_linux.Low_level.alloc_fixed_or_wait () in
-      (fun () ->
+       Eio_linux.Low_level.free_fixed x
-         let x = Eio_linux.Low_level.alloc_fixed_or_wait () in
+    )
-         Eio_linux.Low_level.free_fixed x
+    (fun () ->
-      )
+       Eio_linux.Low_level.free_fixed block
-      (fun () ->
+    );
-         Eio_linux.Low_level.free_fixed block
+  (* The old block is passed to the waiting fiber, but it's cancelled. *)
-      );
+  let block = Eio_linux.Low_level.alloc_fixed_or_wait () in
-    (* The old block is passed to the waiting fiber, but it's cancelled. *)
+  Fiber.both
-    let block = Eio_linux.Low_level.alloc_fixed_or_wait () in
+    (fun () ->
-    Fiber.both
+       Fiber.first
-      (fun () ->
+         (fun () -> ignore (Eio_linux.Low_level.alloc_fixed_or_wait ()); assert false)
-         Fiber.first
+         (fun () -> ())
-           (fun () -> ignore (Eio_linux.Low_level.alloc_fixed_or_wait ()); assert false)
+    )
-           (fun () -> ())
+    (fun () -> Eio_linux.Low_level.free_fixed block);
-      )
+  let block = Eio_linux.Low_level.alloc_fixed_or_wait () in
-      (fun () -> Eio_linux.Low_level.free_fixed block);
+  Eio_linux.Low_level.free_fixed block
-    let block = Eio_linux.Low_level.alloc_fixed_or_wait () in
-    Eio_linux.Low_level.free_fixed block
 
 let () =
   let open Alcotest in

lib_eio_windows/unix_cstruct.ml

@@ -0,0 +1,42 @@
+(* See the end of the file for the license *)
+external stub_write : Unix.file_descr -> Cstruct.t -> int = "eio_windows_cstruct_write"
+
+let rec write fd buf =
+  if Cstruct.length buf > 0 then begin
+    let n = stub_write fd buf in
+    write fd @@ Cstruct.shift buf n
+  end
+
+let writev fd bufs = List.iter (write fd) bufs
+
+external read : Unix.file_descr -> Cstruct.t -> int = "eio_windows_cstruct_read"
+
+(* From mirage/ocaml-cstruct
+Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
+Copyright (c) 2012 Pierre Chambart
+Copyright (c) Christiano F. Haesbaert <haesbaert@haesbaert.org>
+Copyright (c) Citrix Inc
+Copyright (c) David Sheets <sheets@alum.mit.edu>
+Copyright (c) Drup <drupyog@zoho.com>
+Copyright (c) Hannes Mehnert <hannes@mehnert.org>
+Copyright (c) Jeremy Yallop <yallop@gmail.com>
+Copyright (c) Mindy Preston <meetup@yomimono.org>
+Copyright (c) Nicolas Ojeda Bar <n.oje.bar@gmail.com>
+Copyright (c) Richard Mortier <mort@cantab.net>
+Copyright (c) Rudi Grinberg <rudi.grinberg@gmail.com>
+Copyright (c) Thomas Gazagnaire <thomas@gazagnaire.com>
+Copyright (c) Thomas Leonard <talex5@gmail.com>
+Copyright (c) Vincent Bernardoff <vb@luminar.eu.org>
+Copyright (c) pqwy <david@numm.org>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)

tests/fiber.md

@@ -191,23 +191,21 @@ Cancelled from parent:
 Exception: Failure "Parent cancel".
 ```
 
-Cancelled from parent while already cancelling
+Cancelled from parent while already cancelling:
-(we return the value despite the cancellation):
 
 ```ocaml
 # run @@ fun () ->
   Fiber.both
     (fun () ->
-      traceln "%s" @@ Fiber.first
+      let _ = Fiber.first
         (fun () -> "a")
-        (fun () -> Fiber.yield (); failwith "cancel-b");
+        (fun () -> Fiber.yield (); failwith "cancel-b")
-      Fiber.check ();
+      in
       traceln "Parent cancel failed"
     )
     (fun () -> traceln "Cancelling parent"; failwith "Parent cancel");
   "not-reached";;
 +Cancelling parent
-+a
 Exception: Failure "Parent cancel".
 ```