1. james woodyatt
  2. oni

Commits

jhwoodyatt  committed 91d7ce2

Add test for Mime_stream module.

  • Participants
  • Parent commits a5fa36e
  • Branches default

Comments (0)

Files changed (1)

File mime/t/t_mime.ml

View file
  • Ignore whitespace
 Random.self_init ();;
 
 (**)
-module J = Cf_journal
-let jout = J.stdout
-let _ = jout#setlimit `Debug
+let jout = Cf_journal.stdout
+let _ = jout#setlimit `None
 (**)
 
 module T1 = struct
         body
     
     let test () =
-        let e = new emitting ~cte ~ct ~cid ~cl (Cf_message.create body) in
+        let e = emit ~cte ~ct ~cid ~cl (Cf_message.create body) in
         let m = e#emit in
         let h' = Cf_message.contents m in
         if h' <> h then jout#fail "emit error [%s][%s]" h' h;
         if body <> body' then
             jout#fail "Body match error"
 end
+module T4 = struct
+    module G = Iom_gadget
+    open Cf_cmonad.Op
+
+    let cte = Mime_entity.CTE_binary
+
+    let ct = {
+        Mime_entity.ct_type = Mime_entity.CT_text;
+        ct_subtype = "xml";
+        ct_parameters = Mime_atom.Map.of_list [ "charset", "utf8" ];
+    }
+        
+    let body = Cf_message.create "<greeting/>\r\n"
+
+    let plain =
+        "Content-Type: text/xml; charset=utf8\r\n" ^
+        "Content-Transfer-Encoding: binary\r\n" ^
+        "\r\n" ^
+        "<greeting/>"
+
+    let okay = ref false
+
+    let reader_ fd k =
+        Iom_file.read ~e:8 ~fd k >>= fun rd ->
+        let p = Mime_entity.parse in
+        Mime_stream.ingest ~e:1500 ~p rd >>= fun rd ->
+        let rec loop () =
+            G.guard begin
+                rd.Mime_stream.rd_sigRx#get do_sigRx >>= fun () ->
+                rd.Mime_stream.rd_dataRx#get do_dataRx
+            end
+        and do_sigRx (`Error x) =
+            raise x
+        and do_dataRx m =
+            G.load >>= fun s ->
+            let s = s @ m#octets in
+            let str = Cf_message.contents s in
+            match m#more with
+            | Iom_file.More ->
+                G.store s >>= fun () ->
+                loop ()
+            | Iom_file.Last ->
+                okay := begin
+                    let h = m#header in
+                    h#content_transfer_encoding = Some cte &&
+                    h#content_type = Some ct &&
+                    (Cf_message.contents body) = str
+                end;
+                Cf_cmonad.return ()
+        in
+        G.start (loop ()) [] >>= fun () ->
+        rd.Mime_stream.rd_ctrlTx#put `Ready
+
+    let writer_ fd k =
+        Iom_file.write ~fd k >>= fun wr ->
+        Mime_stream.render ~e:5 wr >>= fun wr ->
+        let rec loop () =
+            G.guard begin
+                wr.Mime_stream.wr_sigRx#get begin function
+                    | `Error x -> raise x
+                    | `Final -> Cf_cmonad.return ()
+                    | _ -> loop ()
+                end
+            end
+        in
+        G.start (loop ()) () >>= fun () ->
+        let h = Mime_entity.emit ~ct ~cte [] in
+        let frag = new Mime_stream.fragment Iom_file.Last body h in
+        wr.Mime_stream.wr_dataTx#put frag
+    
+    let reactor_ k = 
+        let rd, wr = Unix.pipe () in
+        Unix.set_nonblock rd;
+        Unix.set_nonblock wr;
+        reader_ rd k >>= fun () ->
+        writer_ wr k >>= fun () ->
+        Cf_cmonad.return ()
+
+    let test () =
+        try
+            G.run reactor_ ();
+            if not !okay then failwith "reactor: processing completed early."
+        with
+        | Unix.Unix_error (error, fname, arg) ->
+            let msg =
+                let error = Unix.error_message error in
+                Printf.sprintf "Unix error \"%s\" in %s(%s).\n" error fname arg
+            in
+            failwith msg
+        | x ->
+            raise x
+end
 
 let main () =
     let tests = [
-        T1.test; T2.test; T3.test
+        T1.test; T2.test; T3.test; T4.test
     ] in
     Printf.printf "1..%d\n" (List.length tests);
     flush stdout;