Merge pull request #291 from talex5/failf

Deprecate Debug.failf

capnp-rpc-net/parse.ml

@@ -103,7 +103,7 @@ module Make_basic
       | Caller -> `Caller
       | Yourself -> `Yourself
       | ThirdParty _ -> failwith "TODO: parse_call: ThirdParty"
-      | Undefined x -> Capnp_rpc.Debug.failf "Unknown SendResultsTo type %d" x
+      | Undefined x -> Fmt.failwith "Unknown SendResultsTo type %d" x
     in
     `Call (aid, target, msg, descs, results_to)
 
@@ -122,15 +122,15 @@ module Make_basic
     | Disembargo.Context.ReceiverLoopback embargo_id -> `Disembargo_reply (target, EmbargoId.of_uint32 embargo_id)
     | Disembargo.Context.Accept
     | Disembargo.Context.Provide _ -> failwith "TODO: handle_disembargo: 3rd-party"
-    | Disembargo.Context.Undefined x -> Capnp_rpc.Debug.failf "Unknown Disembargo type %d" x
+    | Disembargo.Context.Undefined x -> Fmt.failwith "Unknown Disembargo type %d" x
 
   let parse_resolve x =
     let open Reader in
     let new_target =
       match Resolve.get x with
       | Resolve.Cap d -> Ok (parse_desc d)
       | Resolve.Exception e -> Error (parse_exn e)
-      | Resolve.Undefined x -> Capnp_rpc.Debug.failf "Resolved to Undefined(%d)!" x
+      | Resolve.Undefined x -> Fmt.failwith "Resolved to Undefined(%d)!" x
     in
     let import_id = Resolve.promise_id_get x |> ImportId.of_uint32 in
     `Resolve (import_id, new_target)

capnp-rpc/proto/capTP.ml

@@ -152,7 +152,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
 
     let mark_resolved t ~get_import result =
       if t.resolution <> `Unresolved then
-        Debug.failf "Got Resolve for already-resolved import %a" pp t
+        Fmt.failwith "Got Resolve for already-resolved import %a" pp t
       else match result with
         | Error _ -> t.resolution <- `Error
         | Ok desc ->
@@ -545,15 +545,15 @@ module Make (EP : Message_types.ENDPOINT) = struct
     (* We're sending a return message. *)
     let return_resolved t ~exports_for_release ~resolve_targets =
       match t.state with
-      | `Finished -> Debug.failf "Can't return finished answer %a!" pp t
+      | `Finished -> Fmt.failwith "Can't return finished answer %a!" pp t
       | `Active x ->
         assert (x.resolution = `Unresolved);
         t.state <- `Active {x with resolution = `Resolved (resolve_targets, exports_for_release)}
 
     (* We're sending a TakeFromOtherQuestion return message. *)
     let return_take_from_question t question =
       match t.state with
-      | `Finished -> Debug.failf "Can't return finished answer %a!" pp t
+      | `Finished -> Fmt.failwith "Can't return finished answer %a!" pp t
       | `Active x ->
         assert (x.resolution = `Unresolved);
         Question.inc_ref question;
@@ -562,7 +562,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
     (* Remove from Answers table after calling this. *)
     let finish t ~release_result_caps =
       match t.state with
-      | `Finished -> Debug.failf "Can't finish already-finished answer %a" pp t
+      | `Finished -> Fmt.failwith "Can't finish already-finished answer %a" pp t
       | `Active {answer; resolution} ->
         t.state <- `Finished;
         dec_ref answer;
@@ -594,14 +594,14 @@ module Make (EP : Message_types.ENDPOINT) = struct
        [None] if we didn't return yet. *)
     let resolve_target t path =
       match t.state with
-      | `Finished -> Debug.failf "Answer %a is finished!" pp t
+      | `Finished -> Fmt.failwith "Answer %a is finished!" pp t
       | `Active {answer; resolution} ->
         match resolution with
         | `Unresolved -> None
         | `Forwarded q -> Some (Ok (`QuestionCap (q, path)))
         | `Resolved (resolve_targets, _) ->
           match answer#response with
-          | None -> Debug.failf "Answer %a is resolved, but no response recorded!" pp t
+          | None -> Fmt.failwith "Answer %a is resolved, but no response recorded!" pp t
           | Some (Error _) as e -> e
           | Some (Ok msg) ->
             match Core_types.Wire.Response.cap_index msg path with
@@ -612,7 +612,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
 
     let disembargo_target t path =
       match resolve_target t path with
-      | None -> Debug.failf "Got disembargo request for unresolved answer %a!" pp t
+      | None -> Fmt.failwith "Got disembargo request for unresolved answer %a!" pp t
       | Some (Error _) -> failwith "Got disembargo for an exception!"
       | Some (Ok target) -> target
 
@@ -629,7 +629,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
     let init t answer =
       match t.state with
       | `Finished -> t.state <- `Active { answer; resolution = `Unresolved }
-      | `Active _ -> Debug.failf "Answer %a already initialised!" pp t
+      | `Active _ -> Fmt.failwith "Answer %a already initialised!" pp t
   end
 
   module Export = struct
@@ -770,7 +770,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
   let check_connected t =
     match t.disconnected with
     | None -> ()
-    | Some ex -> Debug.failf "CapTP connection is disconnected (%a)" Exception.pp ex
+    | Some ex -> Fmt.failwith "CapTP connection is disconnected (%a)" Exception.pp ex
 
   module Send : sig
     (** Converts struct pointers into integer table indexes, ready for sending.
@@ -1157,7 +1157,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
 
         method resolve cap =
           match state with
-          | Set _ -> Debug.failf "Can't resolve already-set switchable %t to %t!" self#pp cap#pp
+          | Set _ -> Fmt.failwith "Can't resolve already-set switchable %t to %t!" self#pp cap#pp
           | Unset {handler = _; rc; on_set; on_release} ->
             let pp f = self#pp f in
             RC.check ~pp rc;
@@ -1522,7 +1522,7 @@ module Make (EP : Message_types.ENDPOINT) = struct
       | `AcceptFromThirdParty -> failwith "todo: AcceptFromThirdParty"
       | `TakeFromOtherQuestion aid ->
         match Answer.answer_struct (Answers.find_exn t.answers aid) with
-        | `Finished -> Debug.failf "Can't take from answer %a - it's already finished!" AnswerId.pp aid
+        | `Finished -> Fmt.failwith "Can't take from answer %a - it's already finished!" AnswerId.pp aid
         | `Promise other ->
           match question.remote_promise with
           | `Released -> `TakeFromCancelledQuestion
@@ -1608,8 +1608,8 @@ module Make (EP : Message_types.ENDPOINT) = struct
     let send_disembargo t embargo_id target =
       let desc =
         match target with
-        | `None -> Debug.failf "Protocol error: disembargo request for None cap"
-        | `Local -> Debug.failf "Protocol error: disembargo request for local target"
+        | `None -> Fmt.failwith "Protocol error: disembargo request for None cap"
+        | `Local -> Fmt.failwith "Protocol error: disembargo request for local target"
         | `QuestionCap (question, path) -> Question.message_target question path
         | `Import import -> Import.message_target import
       in

capnp-rpc/proto/debug.mli

@@ -15,6 +15,7 @@ val pp_exn : exn Fmt.t
 (** [pp_exn] is like [Fmt.exn], but pretty-prints [Invariant_broken]. *)
 
 val failf : ('a, Format.formatter, unit, 'b) format4 -> 'a
+[@@deprecated "Use Fmt.failwith instead"]
 (** [failf msg] raises [Failure msg]. *)
 
 val invariant_broken : (Format.formatter -> unit) -> 'a

capnp-rpc/proto/rC.ml

@@ -13,14 +13,14 @@ let sum ~pp:pp_obj t d =
   if t > 0 then (
     let t' = t + d in
     if t' < 0 then (
-      if d > 0 then Debug.failf "Ref-count %a + %d would wrap!" pp t d pp_obj
-      else Debug.failf "Ref-count %a - %d would go negative!" pp t (-d) pp_obj
+      if d > 0 then Fmt.failwith "Ref-count %a + %d would wrap!" pp t d pp_obj
+      else Fmt.failwith "Ref-count %a - %d would go negative!" pp t (-d) pp_obj
     );
     t'
   ) else if d >= 0 then (
-    Debug.failf "Attempt to change ref-count (to %a+%d) on freed resource %t" pp t d pp_obj
+    Fmt.failwith "Attempt to change ref-count (to %a+%d) on freed resource %t" pp t d pp_obj
   ) else (
-    Debug.failf "Attempt to change ref-count (to %a%d) on freed resource %t" pp t d pp_obj
+    Fmt.failwith "Attempt to change ref-count (to %a%d) on freed resource %t" pp t d pp_obj
   )
 
 let succ ~pp t = sum ~pp t 1

capnp-rpc/proto/struct_proxy.ml

@@ -424,7 +424,7 @@ module Make (C : S.CORE_TYPES) = struct
             assert (f.ref_count > RC.one);
             self#check_invariants
           )
-        ~forwarding:(fun _ -> Debug.failf "Promise is resolved, but field %a isn't!" Wire.Path.pp i)
+        ~forwarding:(fun _ -> Fmt.failwith "Promise is resolved, but field %a isn't!" Wire.Path.pp i)
 
     method field_pp path f =
       match state with

fuzz/fuzz.ml

@@ -8,7 +8,7 @@ let running_under_afl =
   | [] -> assert false
   | [_] -> false
   | [_; "--fuzz"] -> true
-  | prog :: _ -> Capnp_rpc_proto.Debug.failf "Usage: %s < input-data" prog
+  | prog :: _ -> Fmt.failwith "Usage: %s < input-data" prog
 
 let test_script_path = "test_script.ml"
 

test/proto/testbed/services.ml

@@ -41,7 +41,7 @@ let manual () = object (self)
 
   method pop_n msg =
     match Queue.pop queue with
-    | exception Queue.Empty -> Capnp_rpc_proto.Debug.failf "Empty queue (expecting %S)" msg
+    | exception Queue.Empty -> Fmt.failwith "Empty queue (expecting %S)" msg
     | actual, answer ->
       Alcotest.(check string) ("Expecting " ^ msg) msg actual.Msg.data;
       let args = Request_payload.snapshot_caps actual in

unix/capnp_rpc_unix.ml

@@ -162,7 +162,7 @@ let create_server ?tags ?restore ~sw ~net config =
     | `Unix _ as addr -> Eio.Net.listen ~sw ~backlog ~reuse_addr:true net addr
     | `TCP (host, port) ->
       match Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port) with
-      | [] -> Capnp_rpc.Debug.failf "No addresses found for host name %S" host
+      | [] -> Fmt.failwith "No addresses found for host name %S" host
       | addr :: _ ->
         let socket = Eio.Net.listen ~sw ~backlog ~reuse_addr:true net addr in
         let unix_socket = Eio_unix.Resource.fd_opt socket |> Option.get in

unix/network.ml

@@ -64,7 +64,7 @@ let connect net ~sw ~secret_key (addr, auth) =
     | `Unix _ as x -> x
     | `TCP (host, port) ->
       match Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port) with
-      | [] -> Capnp_rpc.Debug.failf "No addresses found for host name %S" host
+      | [] -> Fmt.failwith "No addresses found for host name %S" host
       | addr :: _ -> addr
   in
   Log.info (fun f -> f "Connecting to %a..." Eio.Net.Sockaddr.pp eio_addr);