test/ocaml/server/TestServer.ml

   1 open Thrift
   2 open ThriftTest_types
   3
   4 let p = Printf.printf;;
   5 exception Die;;
   6 let sod = function
   7     Some v -> v
   8   | None -> raise Die;;
   9
  10
  11 class test_handler =
  12 object (self)
  13   inherit ThriftTest.iface
  14   method testVoid = p "testVoid()\n"
  15   method testString x = p "testString(%s)\n" (sod x); (sod x)
  16   method testByte x = p "testByte(%d)\n" (sod x); (sod x)
  17   method testI32 x = p "testI32(%d)\n" (sod x); (sod x)
  18   method testI64 x = p "testI64(%s)\n" (Int64.to_string (sod x)); (sod x)
  19   method testDouble x = p "testDouble(%f)\n" (sod x); (sod x)
  20   method testStruct x = p "testStruct(---)\n"; (sod x)
  21   method testNest x = p "testNest(---)\n"; (sod x)
  22   method testMap x = p "testMap(---)\n"; (sod x)
  23   method testSet x = p "testSet(---)\n"; (sod x)
  24   method testList x = p "testList(---)\n"; (sod x)
  25   method testEnum x = p "testEnum(---)\n"; (sod x)
  26   method testTypedef x = p "testTypedef(---)\n"; (sod x)
  27   method testMapMap x = p "testMapMap(%d)\n" (sod x);
  28     let mm = Hashtbl.create 3 in
  29     let pos = Hashtbl.create 7 in
  30     let neg = Hashtbl.create 7 in
  31       for i=1 to 4 do
  32         Hashtbl.add pos i i;
  33         Hashtbl.add neg (-i) (-i);
  34       done;
  35       Hashtbl.add mm 4 pos;
  36       Hashtbl.add mm (-4) neg;
  37       mm
  38   method testInsanity x = p "testInsanity()\n";
  39     p "testinsanity()\n";
  40     let hello = new xtruct in
  41     let goodbye = new xtruct in
  42     let crazy = new insanity in
  43     let looney = new insanity in
  44     let cumap = Hashtbl.create 7 in
  45     let insane = Hashtbl.create 7 in
  46     let firstmap = Hashtbl.create 7 in
  47     let secondmap = Hashtbl.create 7 in
  48       hello#set_string_thing "Hello2";
  49       hello#set_byte_thing 2;
  50       hello#set_i32_thing 2;
  51       hello#set_i64_thing 2L;
  52       goodbye#set_string_thing "Goodbye4";
  53       goodbye#set_byte_thing 4;
  54       goodbye#set_i32_thing 4;
  55       goodbye#set_i64_thing 4L;
  56       Hashtbl.add cumap Numberz.EIGHT 8L;
  57       Hashtbl.add cumap Numberz.FIVE 5L;
  58       crazy#set_userMap cumap;
  59       crazy#set_xtructs [goodbye; hello];
  60       Hashtbl.add firstmap Numberz.TWO crazy;
  61       Hashtbl.add firstmap Numberz.THREE crazy;
  62       Hashtbl.add secondmap Numberz.SIX looney;
  63       Hashtbl.add insane 1L firstmap;
  64       Hashtbl.add insane 2L secondmap;
  65       insane
  66   method testMulti a0 a1 a2 a3 a4 a5 =
  67     p "testMulti()\n";
  68     let hello = new xtruct in
  69       hello#set_string_thing "Hello2";
  70       hello#set_byte_thing (sod a0);
  71       hello#set_i32_thing (sod a1);
  72       hello#set_i64_thing (sod a2);
  73       hello
  74   method testException s =
  75     p "testException(%S)\n" (sod s);
  76     if (sod s) = "Xception" then
  77       let x = new xception in
  78         x#set_errorCode 1001;
  79         x#set_message "This is an Xception";
  80         raise (Xception x)
  81     else ()
  82   method testMultiException a0 a1 =
  83     p "testMultiException(%S, %S)\n" (sod a0) (sod a1);
  84     if (sod a0) = "Xception" then
  85       let x = new xception in
  86         x#set_errorCode 1001;
  87         x#set_message "This is an Xception";
  88         raise (Xception x)
  89     else (if (sod a0) = "Xception2" then
  90               let x = new xception2 in
  91               let s = new xtruct in
  92                 x#set_errorCode 2002;
  93                 s#set_string_thing "This as an Xception2";
  94                 x#set_struct_thing s;
  95                 raise (Xception2 x)
  96           else ());
  97     let res = new xtruct in
  98       res#set_string_thing (sod a1);
  99       res
 100 end;;
 101
 102 let h = new test_handler in
 103 let proc = new ThriftTest.processor h in
 104 let port = 9090 in
 105 let pf = new TBinaryProtocol.factory in
 106 let server = new TThreadedServer.t
 107   proc
 108   (new TServerSocket.t port)
 109   (new Transport.factory)
 110   pf
 111   pf
 112 in
 113   server#serve
 114
 115