(*---------------------------------------------------------------------------*
  IMPLEMENTATION  t_cf.ml

  Copyright (c) 2003-2006, James H. Woodyatt
  All rights reserved.

  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:

    Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.

    Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in
    the documentation and/or other materials provided with the
    distribution

  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  OF THE POSSIBILITY OF SUCH DAMAGE. 
 *---------------------------------------------------------------------------*)

Random.self_init ();;

let jout = Cf_journal.stdout
let _ = jout#setlimit `Notice

(*
Gc.set {
    (Gc.get ()) with
    (* Gc.verbose = 0x3ff; *)
    Gc.verbose = 0x14;
};;

Gc.create_alarm begin fun () ->
    let min, pro, maj = Gc.counters () in
    Printf.printf "[Gc] minor=%f promoted=%f major=%f\n" min pro maj;
    flush stdout
end
*)

module T1 = struct
    module R = Cf_rbtree.Map(Cf_ordered.Int_order)
    open R
    
    let decreasing = to_seq_decr
    
    let rec printlist s nl =
        assert begin
            let b = Buffer.create 40 in
            Printf.bprintf b "%s: [" s;
            List.iter (fun n -> Printf.bprintf b " %d;" n) nl;
            Printf.bprintf b " ]\n";
            jout#debug "%s" (Buffer.contents b)
        end
    
    let to_list tree =
        Cf_seq.fold (fun v (e, _) -> e :: v) [] (decreasing tree)
        
    let testcontent tree lst =
        printlist "testcontent" lst;
        let c = to_list tree in
        if c <> lst then begin
            printlist "found" c;
            failwith "testcontent"
        end
        
    let testfind tree key =
        let msg = Printf.sprintf "testfind %d" key in
        printlist msg (to_list tree);
        try
            let e = search key tree in
            assert (member key tree);
            if (e / 2) <> key then failwith "testfind key <> e / 2"
        with
        | Not_found ->
            assert (not (member key tree));
            failwith "testfind -> Not_found"
    
    let testextract tree key =
        let msg = Printf.sprintf "testextract %d" key in
        printlist msg (to_list tree);
        try
            let e, nt = extract key tree in
            if (e / 2) <> key then failwith "testextract -> e <> key";
            nt
        with
        | Not_found ->
            failwith "testextract -> Not_found"
    
    let test0 () =
        let t1, old = insert (1, 2) nil in
        if old <> None then failwith "t1 replaced a nil";
        testcontent t1 [ 1 ];
        testfind t1 1;
        let d1 = testextract t1 1 in
        testcontent d1 [];
        let t2, old = insert (2, 4) t1 in
        if old <> None then failwith "t2 replaced a nil";
        testcontent t2 [ 1; 2 ];
        testfind t2 1;
        testfind t2 2;
        let d1 = testextract t2 1 in
        testcontent d1 [ 2 ];
        let d2 = testextract t2 2 in
        testcontent d2 [ 1 ];
        let d12 = testextract d1 2 in
        testcontent d12 [];
        let d21 = testextract d2 1 in
        testcontent d21 [];
        let t3, old = insert (3, 6) t2 in
        if old <> None then failwith "t3 replaced a nil";
        testfind t3 1;
        testfind t3 2;
        testfind t3 3;
        let d1 = testextract t3 1 in
        testcontent d1 [ 2; 3 ];
        let d2 = testextract t3 2 in
        testcontent d2 [ 1; 3 ];
        let d3 = testextract t3 3 in
        testcontent d3 [ 1; 2 ];
        testfind d1 3;
        testfind d1 2;
        testfind d2 1;
        testfind d2 3;
        testfind d3 1;
        testfind d3 2;
        let d12 = testextract d1 2 in
        testcontent d12 [ 3 ];
        let d23 = testextract d2 3 in
        testcontent d23 [ 1 ];
        let d31 = testextract d3 1 in
        testcontent d31 [ 2 ];
        testfind d12 3;
        testfind d23 1;
        testfind d31 2;
        let d123 = testextract d12 3 in
        let d231 = testextract d23 1 in
        let d312 = testextract d31 2 in
        testcontent d123 [];
        testcontent d231 [];
        testcontent d312 [];
        ()
    
    let test () = test0 ()
end

module T2 = struct        
    module S1 = Set.Make(Cf_ordered.Int_order)
    module S2 = Cf_rbtree.Set(Cf_ordered.Int_order)
    
    let bound = 64
    let iterations = 512
    
    (*
    let print_list =
        let rec loop = function
            | [] -> ()
            | hd :: [] -> Printf.printf "%d" hd
            | hd :: tl -> Printf.printf "%d; " hd; loop tl
        in
        fun id r ->
            Printf.printf "%s [ " id;
            loop r;
            print_string " ]\n";
            flush stdout
    *)
    
    let rec loop n s1 s2 =
        let x = Random.int bound in
        let msg, s1, s2 =
            if S1.mem x s1 then
                "remove failure", S1.remove x s1, S2.clear x s2
            else
                "add failure", S1.add x s1, S2.put x s2
        in
        let n = pred n in
        let e1 = S1.elements s1 and e2 = S2.to_list_incr s2 in
        (*
        print_list "e1" e1;
        print_list "e2" e2;
        *)
        if e1 <> e2 then failwith msg;
        if n > 0 then loop n s1 s2
    
    let test () =
        loop iterations S1.empty S2.nil
end

module T3 = struct
    module M = Cf_rbtree.Map(Cf_ordered.Int_order)
    
    let test1 () =
        let m = M.replace (0, "zero") M.nil in
        let s = M.search 0 m in
        assert (s = "zero");
        assert (M.member 0 m)
    
    let nearest_succ key m =
        match Lazy.force (M.nearest_incr key m) with
        | Cf_seq.Z ->
            raise Not_found
        | Cf_seq.P (hd, _) ->
            hd
    
    let nearest_pred key m =
        match Lazy.force (M.nearest_decr key m) with
        | Cf_seq.Z ->
            raise Not_found
        | Cf_seq.P (hd, _) ->
            hd
    
    let test2 () =
        let m = [
            1, "one";
            3, "three";
            5, "five";
            7, "seven";
            9, "nine";
            11, "eleven";
            13, "thirteen";
            15, "fifteen";
            17, "seventeen";
            19, "nineteen";
        ] in
        let m = M.of_list_incr m in
        if nearest_succ 0 m <> (1, "one") then
            failwith "nearest_succ 0";
        if nearest_succ 1 m <> (1, "one") then
            failwith "nearest_succ 01";
        if nearest_succ 2 m <> (3, "three") then
            failwith "nearest_succ 2";
        if nearest_pred 20 m <> (19, "nineteen") then
            failwith "nearest_pred 20";
        if nearest_pred 19 m <> (19, "nineteen") then
            failwith "nearest_pred 19";
        if nearest_pred 18 m <> (17, "seventeen") then
            failwith "nearest_pred 18";
        ()
    
    let test () =
        test1 ();
        test2 ();
end

module T4 = struct
    (* open Cf_vwdeque *)
    (* open Cf_kotdeque *)
    open Cf_deque
    
    let aux msg i _ (* q *) =
        assert begin
            (* jout#debug "%s i=%d q=%s\n" msg i (sprint string_of_int q) *)
            (**) jout#debug "%s i=%d\n" msg i (**)
        end
        
    let modaux msg modulo i q =
        if ((i / modulo) * modulo) = i then aux msg i q

    let test1 pop push =
        let n = 1024 in
        let rec loop1 i q =
            aux "+" i q;
            if i < n then loop1 (succ i) (push i q) else loop2 0 q
        and loop2 i q =
            (* aux "-" i q; *)
            if i < n then begin
                match pop q with
                | None ->
                    failwith "[1] pop: None"
                | Some (j, q) ->
                    if i <> j then
                        jout#fail "[1] i <> j j=%d" j;
                    loop2 (succ i) q
            end
            else
                match pop q with
                | None -> ()
                | Some _ -> failwith "[1] pop: Some _"
        in
        loop1 0 nil
    
    let test2 pop push ncat =
        let size = 10000 (* and m = 1 *) in
        let chunk = 100 in
        let rec cons i q = function
            | j when j > 0 ->
                (* modaux "+" m i q; *)
                cons (succ i) (push i q) (pred j)
            | _ ->
                i, q
        in
        let rec load i j z =
            let i, j, q0, q1 =
                if z > chunk then begin
                    let z = z / chunk in
                    let z = if z < chunk then chunk else z in
                    let i, j, q0 = load i j z in
                    let i, j, q1 = load i j z in
                    i, j, q0, q1
                end
                else begin
                    assert (z = chunk);
                    let x = Random.int z in
                    let x = if x > j then j else x in
                    let j = j - x in
                    let i, q0 = cons i nil x in
                    let y = Random.int z in
                    let y = if y > j then j else y in
                    let j = j - y in
                    let i, q1 = cons i nil y in
                    i, j, q0, q1 
                end
            in
            let q' = ncat q0 q1 in
            (* aux "%" i q'; *)
            if j > 0 && z > chunk then begin
                let i, j, q = load i j z in
                let q' = ncat q' q in
                (* aux "%" i q'; *)
                i, j, q'
            end
            else
                i, j, q'
        in
        let rec unload i q =
            (* modaux "-" m i q; *)
            if i < size then begin
                match pop q with
                | None ->
                    failwith "[2] pop: None"
                | Some (j, q) ->
                    if i <> j then
                        failwith (Printf.sprintf "[2] i <> j i=%d j=%d" i j);
                    unload (succ i) q
            end
            else
                match pop q with
                | None -> ()
                | Some _ -> failwith "[2] pop: Some _"
        in
        let i, j, q = load 0 size size in
        if i <> size then failwith "[2] load: i <> size";
        if j <> 0 then failwith "[2] load: j <> 0";
        unload 0 q
    
    let test () =
        test1 A.pop B.push;
        test1 B.pop A.push;
        test2 A.pop B.push catenate;
        test2 B.pop A.push (fun q2 q1 -> catenate q1 q2);
        ()
end

module T5 = struct
    open Cf_seq
        
    let (!$) s = Cf_seq.head s, Cf_seq.tail s
    
    let test () =
        let s = of_substring "abc" 0 in
        let ch, s = !$ s in
        if ch <> 'a' then failwith "next 0";
        let _ = !$ s in
        let ch, s = !$ s in
        if ch <> 'b' then failwith "next 1";
        let _ = !$ s in
        let _ = !$ s in
        let ch, s = !$ s in
        if ch <> 'c' then failwith "next 2";
        try ignore (!$ s); failwith "terminal" with Cf_seq.Empty -> ()
end

module T6 = struct
    open Printf
    open Cf_lex.Op
    open Cf_parser.Op
        
    module L1 = struct        
        let test1 lexer =
            let token0 = "abaabaababbabb" in
            let input = token0 (* ^ "jhw" *) in
            let s = Cf_seq.of_substring input 0 in
            let token, s' =
                match lexer s with
                | Some x -> x
                | None -> failwith "No match! [L1.1]"
            in
            if Lazy.force s' <> Cf_seq.Z then
                failwith "Unexpected trailer [1]!";
            if token <> token0 then
                failwith (sprintf "Bad match! [msg='%s']" token)
        
        let test2 lexer =
            let token0 = "abaabaababbabb" in
            let input = token0 ^ "jhw" in
            let s = Cf_seq.of_substring input 0 in
            let token, s' =
                match lexer s with
                | Some x -> x
                | None -> failwith "No match! [L1.2]"
            in
            if Lazy.force s' = Cf_seq.Z then
                failwith "Expected trailer [2]!";
            if token <> token0 then
                failwith (sprintf "Bad match! [msg='%s']" token)
    end
    
    module L2 = struct
        let p =
            let q0 = Cf_scan_parser.scanf "%3u" (fun y -> y) in
            let q1 = Cf_scan_parser.scanf "%c" (fun y -> y) in
            let q2 = Cf_scan_parser.scanf "%3u" (fun y -> y) in
            q0 >>= fun v0 ->
            q1 >>= fun v1 ->
            q2 >>= fun v2 ->
            ~:(v0, v1, v2)
                
        let y s = p (Cf_seq.of_string s)
        
        let test () =
            match y "1234567" with
            | Some ((123, '4', 567), z) when Lazy.force z = Cf_seq.Z ->
                ()
            | Some ((123, '4', 567), z) ->
                failwith (Cf_seq.to_string z)
            | Some ((v0, v1, v2), _) ->
                failwith (Printf.sprintf "%02u, '%c', %02u" v0 v1 v2)
            | _ ->
                failwith "No match! [L2]"
    end
    
    module L3 = struct
        let qlist_ = [
            "abc", "abc";
            "(a*b+c?.[`t +?]|d)", "`(a`*b`+c`?`.`[``t `+`?`]`|d`)";
        ]
        
        let loop (a, b) =
            let s = Cf_flow.commute_string Cf_regex.unquote b in
            if s <> a then
                failwith (Printf.sprintf "unquoting \"%s\" <> \"%s\"" s a);
            let s = Cf_flow.commute_string Cf_regex.quote a in
            if s <> b then
                failwith (Printf.sprintf "quoting \"%s\" <> \"%s\"" s b);
            ()
        
        let test () = List.iter loop qlist_
    end
    
    module L4 = struct
        let lex =
            Cf_lex.create !@[
                !$"`s+" $= None;
                !$"`w+" $> (fun x -> Some x);
            ]

        let rec loop acc z =
            match lex z with
            | None ->
                Some (List.rev acc, z)
            | Some (None, z) ->
                loop acc z
            | Some (Some tok, z) ->
                loop (tok :: acc) z
        
        let p =
            loop [] >>= fun arr ->
            Cf_parser.fin >>= fun () ->
            ~:arr
    
        let input_ = "bim bam boom"
    
        let test () =
            let s = Cf_seq.of_string input_ in
            match p s with
            | Some ([ "bim"; "bam"; "boom" ], s)
              when Lazy.force s = Cf_seq.Z ->
                ()
            | _ ->
                failwith "parse error!"
    end
    
    module L5 = struct
        let xlist = [
            "a", [ "a" ], [ "x"; "ax"; "" ];

            "abc", [ "abc" ], [ "xxxx" ];

            "[abc]+", [ "abccabc" ], [ "abcdabcd" ];
            
            "ab+c*d?e", [ "abe"; "abbcde" ], [ "ae"; "acde"; "xxxx" ];
            
            "a(bc)+d", [ "abcd"; "abcbcd" ], [ "abc"; "abcabc"; "abcdd" ];

            "(a|b)*abb", [ "abababb"; "ababbabb" ], [ "ababab"; "cde" ];
            
            "[_`a][_`i]*", [ "id0"; "_"; "long_id" ], [ "0"; "" ];
            
            "[ `t]*`w+", [ "foo"; "\t  foo" ], [ "\n"; " "; "" ];
        ]
        
        let yes_ s x v =
            if not (Cf_regex.test x v) then
                jout#fail "Expected '%s' to match expression '%s'." v s
        
        let no_ s x v =
            if Cf_regex.test x v then
                jout#fail "Expected '%s' to match expression '%s'." v s
        
        let test1 (s, yes, no) =
            let x = Cf_regex.of_string s in
            List.iter (yes_ s x) yes;
            List.iter (no_ s x) no
        
        let test () =
            List.iter test1 xlist
    end

    let test () =
        let lexer =
            Cf_lex.create begin
                (!*(!:'a' $| !:'b')) $& !$"abb" $> (fun x -> x)
            end
        in
        L1.test1 lexer;
        L1.test2 lexer;
        L2.test ();
        L3.test ();
        L4.test ();
        L5.test ()
end

module T7 = struct
    open Cf_parser.Op
    
    let digit =
        let zero = int_of_char '0' in
        let sat = Cf_parser.sat (function '0'..'9' -> true | _ -> false) in
        sat >>= fun ch -> ~:((int_of_char ch) - zero)
        
    let unumber =
        let rec to_int x = function
            | [] -> x
            | hd :: tl -> to_int (hd + (x * 10)) tl
        in
        ?+digit >>= fun (d0, dn) -> ~:(to_int 0 (d0 :: dn))

    let plus = ?. '+'
    let minus = ?. '-'
    let mult = ?. '*'
    let div = ?. '/'
    let lparen = ?. '('

    let rparen = Cf_parser.alt [
        ?. ')';
        Cf_parser.err ~f:(fun _ -> failwith "Expected ')'") ();
    ]
    
    let number = Cf_parser.alt [
        unumber;
        
        begin
            plus >>= fun _ ->
            unumber >>= fun n ->
            ~:n
        end;
        
        begin
            minus >>= fun _ ->
            unumber >>= fun n ->
            ~:(-n)
        end;
    ]

    type fval_t = Mul of int | Div of int
    
    let rec expr s = Cf_parser.alt [
        begin
            term >>= fun hd ->
            ?*expr_c >>= fun tl ->
            ~:(List.fold_left (+) hd tl)
        end;

        term;
    ] s
    
    and expr_c s = Cf_parser.alt [
        begin
            plus >>= fun _ ->
            term >>= fun n ->
            ~:n
        end;
        
        begin
            minus >>= fun _ ->
            term >>= fun n ->
            ~:(-n)
        end;
    ] s
    
    and term =
        let f a = function Mul x -> a * x | Div x -> a / x in
        fun s -> Cf_parser.alt [
            begin
                factor >>= fun hd ->
                ?*term_c >>= fun tl ->
                ~:(List.fold_left f hd tl)
            end;
            
            term;
        ] s
    
    and term_c s = Cf_parser.alt [
        begin
            mult >>= fun _ ->
            factor >>= fun n ->
            ~:(Mul n)
        end;
        
        begin
            div >>= fun _ ->
            factor >>= fun n ->
            if n = 0 then failwith "Div 0";
            ~:(Div n)
        end;
    ] s

    and factor s = Cf_parser.alt [
        begin
            lparen >>= fun _ ->
            expr >>= fun e ->
            rparen >>= fun _ ->
            ~:e
        end;
        
        number
    ] s
    
    let run s =
        begin
            expr >>= fun e ->
            Cf_parser.fin >>= fun () ->
            ~:e
        end s
    
    let calc s =
        match run (Cf_seq.of_string s) with
        | Some (o, tl) when Lazy.force tl = Cf_seq.Z -> o
        | Some _ -> failwith "Unparsed trailer"
        | None -> failwith "Parse error"
    
    let positive = [
        "123",  123;
        "-256", -256;
        "2+3", 5;
        "8/(4-2)+1", 5;
    ]
    
    let t_pos (s, x) =
        let x' = calc s in
        if x' <> x then begin
            let msg = Printf.sprintf "'%s' <> %d (%d)" s x x' in
            failwith msg
        end
    
    let test () =
        List.iter t_pos positive
end

module T8 = struct
    module L1 = struct
        module C = Cf_cmonad
        open C.Op
    
        module type M = sig
            val get_int: (unit, int) C.t
            val get_line: (unit, string) C.t
            val get_float: (unit, float) C.t
            
            val put_int: int -> (unit, unit) C.t
            val put_string: string -> (unit, unit) C.t
            val put_float: float -> (unit, unit) C.t
        end
    
        module M: M = struct
            let get_int f = f (read_int ())
            let get_line f = f (read_line ())
            let get_float f = f (read_float ())
            
            let put_int n f = f (print_int n)
            let put_string s f = f (print_string s)
            let put_float x f = f (print_float x)
        end
        
        let get_name =
            M.put_string "What is your name? " >>= fun _ ->
            M.get_line
        
        let get_color =
            M.put_string "What is your favorite color? " >>= fun _ ->
            M.get_line
        
        let get_foo =
            M.put_string "What is a continuation monad? " >>= fun _ ->
            M.get_line
        
        let query =
            get_name >>= fun name ->
            get_color >>= fun color ->
            get_foo >>= fun foo ->
            M.put_string (Printf.sprintf "%s, %s, %s\n" name color foo)
        
        let test () =
            print_string ">>> L1\n";
            C.eval query ();
            print_string "<<< L1\n";
    end
    
    module L2 = struct
        module C = Cf_cmonad
        module SC = Cf_scmonad
        open SC.Op
    
        module type M = sig
            val get_int: (int, unit, int) SC.t
            val get_line: (int, unit, string) SC.t
            val get_float: (int, unit, float) SC.t
            
            val put_int: int -> (int, unit, unit) SC.t
            val put_string: string -> (int, unit, unit) SC.t
            val put_float: float -> (int, unit, unit) SC.t
        end
    
        module M: M = struct
            let get_int f y = f (read_int ()) y
            let get_line f y = f (read_line ()) y
            let get_float f y = f (read_float ()) y
            
            let put_int n f y = f (print_int n) y
            let put_string s f y = f (print_string s) y
            let put_float x f y = f (print_float x) y
        end
                
        let get_name =
            SC.load >>= fun n ->
            let msg = Printf.sprintf "[%d] What is your name? " n in
            M.put_string msg >>= fun _ ->
            SC.store (succ n) >>= fun _ ->
            M.get_line
        
        let get_color =
            SC.load >>= fun n ->
            let msg = Printf.sprintf "[%d] What is your favorite color? " n in
            M.put_string msg >>= fun _ ->
            SC.store (succ n) >>= fun _ ->
            M.get_line
        
        let get_foo =
            SC.load >>= fun n ->
            let msg = Printf.sprintf
                "[%d] What is a state continuation monad? " n
            in
            M.put_string msg >>= fun _ ->
            SC.store (succ n) >>= fun _ ->
            M.get_line
        
        let query =
            get_name >>= fun name ->
            get_color >>= fun color ->
            get_foo >>= fun foo ->
            M.put_string (Printf.sprintf "%s, %s, %s\n" name color foo)

        let test () =
            print_string ">>> L2\n";
            let c =
                C.Op.( >>= ) (SC.down query 0) begin fun s ->
                C.return (Printf.printf "state=%d\n" s)
                end
            in
            C.eval c ();
            print_string "<<< L2\n";
    end
    
    let test () =
        (*
        L1.test ();
        L2.test ();
        *)
        assert true
end

module T9_old = struct
    (*
    let rec logflow w =
        match Lazy.force w with
        | Cf_flow.Z ->
            print_string "| Z\n";
            flush stdout;
            Cf_flow.Z
        | Cf_flow.P (hd, tl) ->
            (* if (int_of_float hd) mod 1000 = 0 then begin *)
                Printf.printf "| P %f\n" hd;
                flush stdout;
            (* end; *)
            Cf_flow.P (hd, lazy (logflow tl))
        | Cf_flow.Q f ->
            Cf_flow.Q begin fun i ->
                Printf.printf "| Q %d\n" i;
                flush stdout;
                logflow (lazy (f i))
            end
    
    let rec circuit0 =
        Cf_flow.Q begin fun n ->
            let hd = (float_of_int n) /. 2.0 in
            let tl = Lazy.lazy_from_val circuit0 in
            Cf_flow.P (hd, tl)
        end
    *)

    open Cf_cmonad.Op
    open Cf_state_gadget
            
    let rec divider i o =
        let i = (i :> ('a, int, float) rx) in
        let o = (o :> ('b, int, float) tx) in
        let rec loop () =
            guard begin
                i#get begin fun (`I n) ->
                    load >>= fun state ->
                    store (succ state) >>= fun () ->
                    let oval = (float_of_int n) /. 2.0 in
                    o#put (`O oval) >>= fun () ->
                    loop ()
                end
            end
        in
        loop ()
    
    let ingest isrc =
        let isrc = (isrc :> ('a, int, float) tx) in
        let rec loop () =
            read >>= fun i ->
            isrc#put (`I i) >>= loop
        in
        loop ()
    
    let render osnk =
        let osnk = (osnk :> ('a, int, float) rx) in
        let rec loop () =
            guard begin
                osnk#get begin fun (`O n) ->
                    write n >>= loop
                end
            end
        in
        loop ()
    
    let gadget x =
        simplex >>= fun (efRx, efTx) ->
        simplex >>= fun (enRx, enTx) ->
        start (ingest enTx) () >>= fun () ->
        start (render efRx) () >>= fun () ->
        start (divider enRx efTx) x
    
    let input =
        let rec loop n = Cf_seq.P (n, lazy (loop (succ n))) in
        fun () -> lazy (loop 1)
    
    let output =
        let rec loop n =
            let x = (float_of_int n) /. 2.0 in
            Cf_seq.P (x, lazy (loop (succ n)))
        in
        fun () -> lazy (loop 1)
    
    open Cf_flow.Op
    
    let test () =
        let n = 100 in
        let i = Cf_seq.limit n (input ()) in
        let o = Cf_seq.limit n (output ()) in
        let divflow = eval (gadget 0) () in
        (* let divflow = lazy (logflow divflow) in *)
        let x = Cf_flow.to_seq (Cf_flow.of_seq i -=- divflow) in
        if not (Cf_seq.equal x o) then failwith "Transform failed!"
end

module T9 = struct
    (*
    let rec logflow w =
        match Lazy.force w with
        | Cf_flow.Z ->
            print_string "| Z\n";
            flush stdout;
            Cf_flow.Z
        | Cf_flow.P (hd, tl) ->
            (* if (int_of_float hd) mod 1000 = 0 then begin *)
                Printf.printf "| P %f\n" hd;
                flush stdout;
            (* end; *)
            Cf_flow.P (hd, lazy (logflow tl))
        | Cf_flow.Q f ->
            Cf_flow.Q begin fun i ->
                Printf.printf "| Q %d\n" i;
                flush stdout;
                logflow (lazy (f i))
            end
    
    let rec circuit0 =
        Cf_flow.Q begin fun n ->
            let hd = (float_of_int n) /. 2.0 in
            let tl = Lazy.lazy_from_val circuit0 in
            Cf_flow.P (hd, tl)
        end
    *)

    open Cf_cmonad.Op
    open Cf_gadget
        
    class divider i o =
        let i = (i :> ('a, int, float) rx) in
        let o = (o :> ('b, int, float) tx) in
        object(self)
            inherit [int, float] start
            inherit [int, float] next
            
            val count = 0
            
            method private input (`I n) =
                o#put (`O ((float_of_int n) /. 2.0)) >>= fun () ->
                {< count = succ count >}#next
            
            method private guard = i#get self#input
        end
    
    let ingest isrc =
        let isrc = (isrc :> ('a, int, float) tx) in
        let rec loop () =
            read >>= fun i ->
            isrc#put (`I i) >>= loop
        in
        loop ()
    
    let render osnk =
        let osnk = (osnk :> ('a, int, float) rx) in
        let rec loop () =
            guard begin
                osnk#get begin fun (`O n) ->
                    write n >>= loop
                end
            end
        in
        loop ()
    
    let gadget () =
        simplex >>= fun (efRx, efTx) ->
        simplex >>= fun (enRx, enTx) ->
        start (ingest enTx) >>= fun () ->
        start (render efRx) >>= fun () ->
        let m = new divider enRx efTx in
        m#start
    
    let input =
        let rec loop n = Cf_seq.P (n, lazy (loop (succ n))) in
        fun () -> lazy (loop 1)
    
    let output =
        let rec loop n =
            let x = (float_of_int n) /. 2.0 in
            Cf_seq.P (x, lazy (loop (succ n)))
        in
        fun () -> lazy (loop 1)
    
    open Cf_flow.Op
    
    let test () =
        let n = 100 in
        let i = Cf_seq.limit n (input ()) in
        let o = Cf_seq.limit n (output ()) in
        let divflow = eval (gadget ()) in
        (* let divflow = lazy (logflow divflow) in *)
        let x = Cf_flow.to_seq (Cf_flow.of_seq i -=- divflow) in
        if not (Cf_seq.equal x o) then failwith "Transform failed!"
end

module T10 = struct
(*
3fffe33e1b840309 365  Sun -1000000-12-31 23:59:59 +0000
3fffe33e1b84030a 000  Mon -999999-01-01 00:00:00 +0000
3ffffff1868b8409 364  Fri -1-12-31 23:59:59 +0000
3ffffff1868b840a 000  Sat 0-01-01 00:00:00 +0000
3ffffff1886e1757 000  Mon 1-01-01 01:01:01 +0000
3ffffff8df7db65f 000  Wed 1000-01-01 12:04:37 +0000
3ffffffec03dbf89 364  Tue 1799-12-31 23:59:59 +0000
3fffffff7c558189 364  Sun 1899-12-31 23:59:59 +0000
3fffffff7c55818a 000  Mon 1900-01-01 00:00:00 +0000
3fffffffffffffff 364  Wed 1969-12-31 23:59:49 +0000
4000000000000000 364  Wed 1969-12-31 23:59:50 +0000
4000000000000009 364  Wed 1969-12-31 23:59:59 +0000
400000000000000a 000  Thu 1970-01-01 00:00:00 +0000
400000000000000b 000  Thu 1970-01-01 00:00:01 +0000
4000000004b25808 181  Fri 1972-06-30 23:59:58 +0000
4000000004b25809 181  Fri 1972-06-30 23:59:59 +0000
4000000004b2580a 181  Fri 1972-06-30 23:59:60 +0000
4000000004b2580b 182  Sat 1972-07-01 00:00:00 +0000
4000000004b2580c 182  Sat 1972-07-01 00:00:01 +0000
4000000030e7241b 364  Sun 1995-12-31 23:59:58 +0000
4000000030e7241c 364  Sun 1995-12-31 23:59:59 +0000
4000000030e7241d 364  Sun 1995-12-31 23:59:60 +0000
4000000030e7241e 000  Mon 1996-01-01 00:00:00 +0000
4000000030e7241d 364  Sun 1995-12-31 23:59:60 +0000
4000000030e7241e 000  Mon 1996-01-01 00:00:00 +0000
4000000030e7241f 000  Mon 1996-01-01 00:00:01 +0000
4000000030e72420 000  Mon 1996-01-01 00:00:02 +0000
4000000033b8489d 180  Mon 1997-06-30 23:59:59 +0000
4000000033b8489e 180  Mon 1997-06-30 23:59:60 +0000
4000000033b8489f 181  Tue 1997-07-01 00:00:00 +0000
4000000033df0226 210  Wed 1997-07-30 08:57:43 +0000
4000000034353637 275  Fri 1997-10-03 18:14:48 +0000
4000000037d77955 251  Thu 1999-09-09 09:09:09 +0000
40000000386d439f 364  Fri 1999-12-31 23:59:59 +0000
40000000386d43a0 000  Sat 2000-01-01 00:00:00 +0000
40000000386d43a1 000  Sat 2000-01-01 00:00:01 +0000
4000000038bb0c1f 058  Mon 2000-02-28 23:59:59 +0000
4000000038bc5d9f 059  Tue 2000-02-29 23:59:59 +0000
4000000038bc5da0 060  Wed 2000-03-01 00:00:00 +0000
400000003a4fc89f 365  Sun 2000-12-31 23:59:59 +0000
40000000f4875017 000  Fri 2100-01-01 17:42:15 +0000
40000001b09f1217 000  Wed 2200-01-01 17:42:15 +0000
40000007915fc517 000  Wed 3000-01-01 17:42:15 +0000
4000003afff53a97 000  Sat 10000-01-01 17:42:15 +0000
40001ca4f3758a1f 364  Fri 999999-12-31 23:59:59 +0000
40001ca4f3758a20 000  Sat 1000000-01-01 00:00:00 +0000
*)

    module L1 = struct
        open Cf_stdtime
        
        let x = [
            "0x400000000000000a", {
                year = 1970;
                month = 1;
                day = 1;
                hour = 0;
                minute = 0;
                second = 0;
            };
            
            "0x4000000004b2580a", {
                year = 1972;
                month = 6;
                day = 30;
                hour = 23;
                minute = 59;
                second = 60;
            };
            
            "0x4000000004b2580b", {
                year = 1972;
                month = 7;
                day = 1;
                hour = 0;
                minute = 0;
                second = 0;
            };
            
            "0x4000000004b2580c", {
                year = 1972;
                month = 7;
                day = 1;
                hour = 0;
                minute = 0;
                second = 1;
            };
            
            "0x4000000030e7241b", {
                year = 1995;
                month = 12;
                day = 31;
                hour = 23;
                minute = 59;
                second = 58;
            };
            
            "0x4000000030e7241c", {
                year = 1995;
                month = 12;
                day = 31;
                hour = 23;
                minute = 59;
                second = 59;
            };
        ]
        
        let tsprintf j =
            let mjd =
                Cf_gregorian.to_mjd ~year:j.year ~month:j.month ~day:j.day
            in
            Printf.sprintf
                "{ mjd=%d %04d-%02d-%02d %02d:%02d:%02d }"
                mjd j.year j.month j.day j.hour j.minute j.second
    
        let y (i, j) =
            (*
            Printf.printf "TAI epoch+%s, %s\n" i (tsprintf j);
            flush stdout;
            *)
            let i = Cf_tai64.add_int64 Cf_tai64.first (Int64.of_string i) in
            let j' = utc_of_tai64 i in
            if j <> j' then failwith (tsprintf j');
            let i' =
                utc_to_tai64_unsafe ~year:j.year ~month:j.month ~day:j.day
                ~hour:j.hour ~minute:j.minute ~second:j.second
            in
            if i <> i' then
                let n = Cf_tai64.sub i' Cf_tai64.first in
                failwith (Int64.format "0x%016x" n)
    end

    let test () = List.iter L1.y L1.x
end

module T11 = struct
    open Cf_scmonad.Op
    
    module String_set = Cf_rbtree.Set(String)
    
    (* val memoize: (string, string) Cf_flow.t *)
    let memoize =
        let rec loop () =
            Cf_flow.readSC >>= fun s ->
            Cf_scmonad.load >>= fun u ->
            if String_set.member s u then
                loop ()
            else
                let u = String_set.put s u in
                Cf_scmonad.store u >>= fun () ->
                Cf_flow.writeSC s >>= fun () ->
                loop ()
        in
        Cf_flow.evalSC (loop ()) String_set.nil
    
    (* val uniq: string list -> string list *)
    let uniq s =
        let z = Cf_seq.of_list s in
        let z = Cf_flow.commute memoize z in
        Cf_seq.to_list z
    
    let test () =
        let s1 = [ "Hello"; "World!"; "Hello"; "AGAIN!" ] in
        let s2 = [ "Hello"; "World!"; "AGAIN!" ] in
        let s2' = uniq s1 in
        if s2 <> s2' then failwith "Error in uniq!"
end

module T12 = struct
    open Cf_state_gadget
    open Cf_cmonad.Op
    
    let gadget limit =
        read >>= fun () ->
        duplex >>= fun ((inRx, outTx), (outRx, inTx)) ->
        let inRx = (inRx :> (unit, unit, unit) rx) in
        let outTx = (outTx :> (unit, unit, unit) tx) in
        let outRx = (outRx :> (unit, unit, unit) rx) in
        let inTx = (inTx :> (unit, unit, unit) tx) in
        inTx#put () >>= fun () ->
        wrap inRx outTx Cf_flow.nop >>= fun () ->
        let rec loop () =
            guard begin
                outRx#get begin fun () ->
                    load >>= fun n ->
                    if n < limit then begin
                        (*
                        if n mod 1000 = 0 then begin
                            Printf.printf "n=%08u\n" n;
                            flush stdout
                        end;
                        *)
                        store (succ n) >>= fun () ->
                        inTx#put () >>= loop
                    end
                    else
                        Cf_cmonad.nil 
                end
            end
        in
        start (loop ()) 0
    
    let test () =
        let limit = 10000 in
        let gc = Gc.get () in
        Gc.set { gc with Gc.stack_limit = 4 * 0x400 };
        let w = eval (gadget limit) () in
        match Lazy.force w with
        | Cf_flow.Q f -> let _ = f () in Gc.set gc
        | _ -> failwith "Cf_state_gadget not evaluated to Cf_flow.Q state."
end

module T13 = struct
    module M = Cf_rbtree.Map (Cf_ordered.Int_order)

    let test1a () =
        let tree = M.of_list (List.map (fun a -> (a,())) [9;1;8;3;7;5;4]) in
        let list = Cf_seq.to_list (Cf_seq.first (M.nearest_incr 6 tree)) in
        match list with
        | [ 7; 8; 9 ] -> ()
        | _ ->
            print_char '[';
            List.iter (Printf.printf " %d;") list;
            print_string " ]";
            print_newline ();
            failwith "Cf_rbtree.nearest_incr error [6]!"

    let test1b () =
        let tree = M.of_list (List.map (fun a -> (a,())) [9;1;8;3;7;5;4]) in
        let list = Cf_seq.to_list (Cf_seq.first (M.nearest_incr 5 tree)) in
        match list with
        | [ 5; 7; 8; 9 ] -> ()
        | _ ->
            print_char '[';
            List.iter (Printf.printf " %d;") list;
            print_string " ]";
            print_newline ();
            failwith "Cf_rbtree.nearest_incr error [5]!"

    let test2 n =
        let tree = M.of_list (List.map (fun a -> (a,())) [9;1;8;3;7;5;4]) in
        let list = Cf_seq.to_list (Cf_seq.first (M.nearest_decr n tree)) in
        match list with
        | [ 5; 4; 3; 1 ] -> ()
        | _ ->
            print_char '[';
            List.iter (Printf.printf " %d;") list;
            print_string " ]";
            print_newline ();
            jout#fail "Cf_rbtree.nearest_decr error [%d]!" n
    
    let test () =
        test1a ();
        test1b ();
        test2 5;
        test2 6
end

(*
module T14 = struct
    open Cf_gadget
    open Cf_cmonad.Op
    
    let gadget limit =
        read >>= fun () ->
        duplex >>= fun ((inRx, outTx), (outRx, inTx)) ->
        let inRx = (inRx :> (unit, unit, unit) rx) in
        let outTx = (outTx :> (unit, unit, unit) tx) in
        let outRx = (outRx :> (unit, unit, unit) rx) in
        let inTx = (inTx :> (unit, unit, unit) tx) in
        inTx#put () >>= fun () ->
        wrap inRx outTx Cf_flow.nop >>= fun () ->
        let rec loop () =
            guard begin
                outRx#get begin fun () ->
                    load >>= fun n ->
                    if n < limit then begin
                        (*
                        if n mod 1000 = 0 then begin
                            Printf.printf "n=%08u\n" n;
                            flush stdout
                        end;
                        *)
                        store (succ n) >>= fun () ->
                        inTx#put () >>= loop
                    end
                    else
                        Cf_cmonad.nil 
                end
            end
        in
        start (loop ()) 0
    
    let test () =
        let limit = 10000 in
        let gc = Gc.get () in
        Gc.set { gc with Gc.stack_limit = 4 * 0x400 };
        let w = eval (gadget limit) () in
        match Lazy.force w with
        | Cf_flow.Q f -> let _ = f () in Gc.set gc
        | _ -> failwith "Cf_state_gadget not evaluated to Cf_flow.Q state."
end
*)


(*
module Obsolete_1 = struct
    module V6 = Cf_ip6_addr
    open Printf
    
    let v6_unicast_cases = [
        "::DEAD:BEEF:D00D", V6.U_reserved;
        "::1", V6.U_loopback;
        "4000::1", V6.U_unassigned;
        "::10.0.1.1", V6.U_v4compat;
        "::FFFF:17.201.23.45", V6.U_v4mapped;
        "2002::1", V6.U_global;
        "FE80::203:93ff:feba:7eba", V6.U_link;
        "FEC0::1", V6.U_site;
        "::224.0.0.1", V6.U_reserved;
    ]
    
    let v6_unicast_test () =
        List.iter begin fun (addr, fmt) ->
            match V6.pton addr with
            | Some addr' ->
                if fmt <> V6.unicast_format (V6.is_unicast addr') then
                    failwith (sprintf "V6.unicast_format %s" addr)
            | None ->
                failwith (sprintf "unrecognized %s" addr)
        end v6_unicast_cases
    
    let test () =
        v6_unicast_test ()
end

module Obsolete_2 = struct
    let len = 10

    let test () =
        try
            let bind =
                (Cf_ip4_addr.loopback :> Cf_ip4_addr.opaque Cf_ip4_addr.t), 0
            in
            let listen = new Cf_tcp4_socket.listener bind in
            listen#listen 1;
            let bind = listen#getsockname in
            let active = new Cf_tcp4_socket.initiator bind in
            active#connect;
            let a, _ = listen#accept in
            let a = new Cf_tcp4_socket.endpoint a in
            let b = new Cf_tcp4_socket.endpoint (active#socket) in
            a#setsockopt Cf_ip_common.tcp_nodelay true;
            b#setsockopt Cf_ip_common.tcp_nodelay true;
            let laddr = a#getpeername and raddr = b#getsockname in
            let lhost, lport = laddr in
            let rhost, rport = raddr in
            if lhost <> rhost then
                failwith "O2 error: host a#getpeername <> b#getsockname";
            if lport <> rport then
                failwith "O2 error: port a#getpeername <> b#getsockname";
            let laddr = a#getsockname and raddr = b#getpeername in
            let lhost, lport = laddr in
            let rhost, rport = raddr in
            if lhost <> rhost then
                failwith "O2 error: host a#getsockname <> b#getpeername";
            if lport <> rport then
                failwith "O2 error: port a#getsockname <> b#getpeername";
            let tx = String.make len 'x' and rx = String.create len in
            let n = a#send tx 0 len in
            if n <> len then failwith "O2 error: tx incomplete!";
            a#shutdown Unix.SHUTDOWN_SEND;
            let n = b#recv rx 0 len in
            if n <> len then failwith "O2 error: rx incomplete!";
            if tx <> rx then failwith "O2 error: tx <> rx!";
            a#close;
            b#close;
            listen#close
        with
        | Unix.Unix_error (e, fn, _) ->
            failwith (Printf.sprintf "O2 error: %s in %s.\n"
                (Unix.error_message e) fn)
end

module Obsolete_3 = struct
    let len = 10

    let test () =
        try
            let bind =
                (Cf_ip6_addr.loopback :> Cf_ip6_addr.opaque Cf_ip6_addr.t),
                0, 0l
            in
            let listen = new Cf_tcp6_socket.listener bind in
            listen#listen 1;
            let bind = listen#getsockname in
            let active = new Cf_tcp6_socket.initiator bind in
            active#connect;
            let a = new Cf_tcp6_socket.endpoint (active#socket) in
            let b, _ = listen#accept in
            let b = new Cf_tcp6_socket.endpoint b in
            a#setsockopt Cf_ip_common.tcp_nodelay true;
            b#setsockopt Cf_ip_common.tcp_nodelay true;
            let laddr = a#getpeername and raddr = b#getsockname in
            let lhost, lport, lscope = laddr in
            let rhost, rport, rscope = raddr in
            if lhost <> rhost then
                failwith "O3 error: host a#getpeername <> b#getsockname";
            if lport <> rport then
                failwith "O3 error: port a#getpeername <> b#getsockname";
            if lscope <> rscope then
                failwith "O3 error: port a#getpeername <> b#getsockname";
            let laddr = a#getsockname and raddr = b#getpeername in
            let lhost, lport, lscope = laddr in
            let rhost, rport, rscope = raddr in
            if lhost <> rhost then
                failwith "O3 error: host a#getsockname <> b#getpeername";
            if lport <> rport then
                failwith "O3 error: port a#getsockname <> b#getpeername";
            if lscope <> rscope then
                failwith "O3 error: port a#getsockname <> b#getpeername";
            let tx = String.make len 'x' and rx = String.create len in
            let n = a#send tx 0 len in
            if n <> len then failwith "O3 error: tx incomplete!";
            a#shutdown Unix.SHUTDOWN_SEND;
            let n = b#recv rx 0 len in
            if n <> len then failwith "O3 error: rx incomplete!";
            if tx <> rx then failwith "O3 error: tx <> rx!";
            a#close;
            b#close;
            listen#close
        with
        | Unix.Unix_error (e, fn, _) ->
            failwith (Printf.sprintf "O3 error: %s in %s.\n"
                (Unix.error_message e) fn)
end

module Obsolete_4 = struct
    open Cf_uri
    
    module L1 = struct
        let test () = ()
    end
    
    module L2 = struct
    
        (* http://a/b/c/d;p?q *)
        let base = {
            abs_scheme = "http";
            abs_special = S_hier {
                abs_hier_query = Some "q";
                abs_hier_path = `Net {
                    net_authority = A_server (Some {
                        srv_user = None;
                        srv_host = H_hostname "a";
                        srv_port = None;
                    });
                    
                    net_path = [
                        { seg_name = "b"; seg_params = [] };
                        { seg_name = "c"; seg_params = [] };
                        { seg_name = "d"; seg_params = [ "p" ] };
                    ];
                };
            };
        }
        
        let basestr = Cf_message.contents (message_of_uri (A base))
        
        let resolve_list = [
            "g:h"           , "g:h";
            "g"             , "http://a/b/c/g";
            "./g"           , "http://a/b/c/g";
            "g/"            , "http://a/b/c/g/";
            "/g"            , "http://a/g";
            "//g"           , "http://g";
            "?y"            , "http://a/b/c/?y";
            "g?y"           , "http://a/b/c/g?y";
            "#s"            , "http://a/b/c/d;p?q#s";
            "g#s"           , "http://a/b/c/g#s";
            "g?y#s"         , "http://a/b/c/g?y#s";
            ";x"            , "http://a/b/c/;x";
            "g;x"           , "http://a/b/c/g;x";
            "g;x?y#s"       , "http://a/b/c/g;x?y#s";
            "."             , "http://a/b/c/";
            "./"            , "http://a/b/c/";
            ".."            , "http://a/b/";
            "../"           , "http://a/b/";
            "../g"          , "http://a/b/g";
            "../.."         , "http://a/";
            "../../"        , "http://a/";
            "../../g"       , "http://a/g";
        ]
        
        let resolve (relstr, expectstr) =
            let rel = Cf_message.create relstr in
            let result = message_to_absolute_uri_reference ~base rel in
            let resultstr =
                Cf_message.contents (message_of_uri_reference result)
            in
            if resultstr <> expectstr then begin
                let s = Printf.sprintf
                    "reference URI resolution error \
                    [rel=\"%s\" expect=\"%s\" result=\"%s\"\n"
                    relstr expectstr resultstr
                in
                failwith s
            end;
            ignore (message_of_uri_reference result)
        
        let unresolved_list = [
            "http://a", "../b";
        ]
        
        let unresolved (basestr, relstr) =
            let base = message_to_uri (Cf_message.create basestr) in
            let rel = message_to_uri (Cf_message.create relstr) in
            let base =
                match base with
                | A base -> base
                | _ -> invalid_arg "base not absolute"
            in
            let rel =
                match rel with
                | R rel -> rel
                | _ -> invalid_arg "rel not relative"
            in
            try
                ignore (refer_to_base ~base ~rel);
                failwith "expected to catch Rel_undefined."
            with
            | Rel_undefined ->
                ()            
        
        let test () =
            if basestr <> "http://a/b/c/d;p?q" then
                failwith "base URI emit error";
            List.iter resolve resolve_list;
            List.iter unresolved unresolved_list
    end

    let test () =
        L1.test ();
        L2.test ();
end

module Obsolete_5 = struct
    open Cf_poll
    
    class clock n dt =
        object
            inherit [unit] time dt as super
            
            val mutable count_ = n
                        
            method private service _ =
                let tai, frac = Cf_tai64n.decompose epoch_ in
                let utc = Cf_stdtime.utc_of_tai64 tai in
                jout#info
                    "O5.clock#service: %04u-%02u-%02u %02u:%02u:%02u.%06u "
                    utc.Cf_stdtime.year utc.Cf_stdtime.month utc.Cf_stdtime.day
                    utc.Cf_stdtime.hour utc.Cf_stdtime.minute
                    utc.Cf_stdtime.second frac;
                if count_ > 0 then begin
                    count_ <- pred count_;
                    state_
                end
                else
                    Cf_poll.Final ()
            
            method count = count_
        end
    
    class interrupt n dt =
        object(self:'self)
            inherit [int] signal Sys.sigint as super

            val clock_ = new clock n dt
            
            method private load_ p =
                clock_#load p;
                super#load_ p
            
            method private unload_ p =
                super#unload_ p;
                clock_#unload
            
            method private service _ =
                clock_#unload;
                Cf_poll.Final clock_#count
            
            method canget =
                if not super#canget then begin
                    if not clock_#canget then
                        false
                    else begin
                        self#unload;
                        state_ <- Cf_poll.Final 0;
                        true
                    end
                end
                else begin
                    clock_#unload;
                    true
                end
        end
    
    let test () =
        let e = new interrupt 10 0.05 in
        let p = create () in
        e#load p;
        let save = Unix.sigprocmask Unix.SIG_SETMASK [] in
        let more = ref More in
        while not e#canget do
            if !more <> More then failwith "!More";
            more := cycle p
        done;
        if !more = More then more := cycle p;
        if !more <> Last then failwith "!Last";
        ignore (Unix.sigprocmask Unix.SIG_SETMASK save)
end
*)

let main () =
    let tests = [
        T1.test; T2.test; T3.test; T4.test; T5.test; T6.test; T7.test;
        T8.test; T9.test; T10.test; T11.test; T12.test; T13.test;
        (*; T15.test *)
        (*
        Obsolete_1.test;
        Obsolete_2.test;
        Obsolete_3.test;
        Obsolete_4.test;
        Obsolete_5.test;
        *)
    ] in
    Printf.printf "1..%d\n" (List.length tests);
    flush stdout;
        
    let test i f =
        begin
            try
                (* let tms0 = Unix.times () in *)
                f ();
                (*
                let tms1 = Unix.times () in
                let ut = tms1.Unix.tms_utime -. tms0.Unix.tms_utime in
                let st = tms1.Unix.tms_stime -. tms0.Unix.tms_stime in
                Printf.printf "ok %d (ut=%f st=%f)\n" i ut st
                *)
                Printf.printf "ok %d\n" i
            with
            | Failure(s) ->
                Printf.printf "not ok %d (Failure \"%s\")\n" i s
            | x ->
                Printf.printf "not ok %d\n" i;
                flush stdout;
                raise x
        end;
        flush stdout;
        succ i
    in
    let _ = List.fold_left test 1 tests in
    exit 0
;;

main ();;


(*--- End of File [ t_cf.ml ] ---*)
