1(*
2 Licensed to the Apache Software Foundation (ASF) under one
3 or more contributor license agreements. See the NOTICE file
4 distributed with this work for additional information
5 regarding copyright ownership. The ASF licenses this file
6 to you under the Apache License, Version 2.0 (the
7 "License"); you may not use this file except in compliance
8 with the License. You may obtain a copy of the License at
9
10   http://www.apache.org/licenses/LICENSE-2.0
11
12 Unless required by applicable law or agreed to in writing,
13 software distributed under the License is distributed on an
14 "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 KIND, either express or implied. See the License for the
16 specific language governing permissions and limitations
17 under the License.
18*)
19
20open Thrift
21open ThriftTest_types
22
23let p = Printf.printf;;
24exception Die;;
25let sod = function
26    Some v -> v
27  | None -> raise Die;;
28
29
30class test_handler =
31object (self)
32  inherit ThriftTest.iface
33  method testVoid = p "testVoid()\n"
34  method testString x = p "testString(%s)\n" (sod x); (sod x)
35  method testByte x = p "testByte(%d)\n" (sod x); (sod x)
36  method testI32 x = p "testI32(%d)\n" (sod x); (sod x)
37  method testI64 x = p "testI64(%s)\n" (Int64.to_string (sod x)); (sod x)
38  method testDouble x = p "testDouble(%f)\n" (sod x); (sod x)
39  method testBinary x = p "testBinary(%s)\n" (sod x); (sod x)
40  method testStruct x = p "testStruct(---)\n"; (sod x)
41  method testNest x = p "testNest(---)\n"; (sod x)
42  method testMap x = p "testMap(---)\n"; (sod x)
43  method testSet x = p "testSet(---)\n"; (sod x)
44  method testList x = p "testList(---)\n"; (sod x)
45  method testEnum x = p "testEnum(---)\n"; (sod x)
46  method testTypedef x = p "testTypedef(---)\n"; (sod x)
47  method testMapMap x = p "testMapMap(%d)\n" (sod x);
48    let mm = Hashtbl.create 3 in
49    let pos = Hashtbl.create 7 in
50    let neg = Hashtbl.create 7 in
51      for i=1 to 4 do
52        Hashtbl.add pos i i;
53        Hashtbl.add neg (-i) (-i);
54      done;
55      Hashtbl.add mm 4 pos;
56      Hashtbl.add mm (-4) neg;
57      mm
58  method testInsanity x = p "testInsanity()\n";
59    p "testinsanity()\n";
60    let hello = new xtruct in
61    let goodbye = new xtruct in
62    let crazy = new insanity in
63    let looney = new insanity in
64    let cumap = Hashtbl.create 7 in
65    let insane = Hashtbl.create 7 in
66    let firstmap = Hashtbl.create 7 in
67    let secondmap = Hashtbl.create 7 in
68      hello#set_string_thing "Hello2";
69      hello#set_byte_thing 2;
70      hello#set_i32_thing 2;
71      hello#set_i64_thing 2L;
72      goodbye#set_string_thing "Goodbye4";
73      goodbye#set_byte_thing 4;
74      goodbye#set_i32_thing 4;
75      goodbye#set_i64_thing 4L;
76      Hashtbl.add cumap Numberz.EIGHT 8L;
77      Hashtbl.add cumap Numberz.FIVE 5L;
78      crazy#set_userMap cumap;
79      crazy#set_xtructs [goodbye; hello];
80      Hashtbl.add firstmap Numberz.TWO crazy;
81      Hashtbl.add firstmap Numberz.THREE crazy;
82      Hashtbl.add secondmap Numberz.SIX looney;
83      Hashtbl.add insane 1L firstmap;
84      Hashtbl.add insane 2L secondmap;
85      insane
86  method testMulti a0 a1 a2 a3 a4 a5 =
87    p "testMulti()\n";
88    let hello = new xtruct in
89      hello#set_string_thing "Hello2";
90      hello#set_byte_thing (sod a0);
91      hello#set_i32_thing (sod a1);
92      hello#set_i64_thing (sod a2);
93      hello
94  method testException s =
95    p "testException(%S)\n" (sod s);
96    if (sod s) = "Xception" then
97      let x = new xception in
98        x#set_errorCode 1001;
99        x#set_message "This is an Xception";
100        raise (Xception x)
101    else ()
102  method testMultiException a0 a1 =
103    p "testMultiException(%S, %S)\n" (sod a0) (sod a1);
104    if (sod a0) = "Xception" then
105      let x = new xception in
106        x#set_errorCode 1001;
107        x#set_message "This is an Xception";
108        raise (Xception x)
109    else (if (sod a0) = "Xception2" then
110              let x = new xception2 in
111              let s = new xtruct in
112                x#set_errorCode 2002;
113                s#set_string_thing "This as an Xception2";
114                x#set_struct_thing s;
115                raise (Xception2 x)
116          else ());
117    let res = new xtruct in
118      res#set_string_thing (sod a1);
119      res
120  method testOneway i =
121    Unix.sleep (sod i)
122end;;
123
124let h = new test_handler in
125let proc = new ThriftTest.processor h in
126let port = 9090 in
127let pf = new TBinaryProtocol.factory in
128let server = new TThreadedServer.t
129  proc
130  (new TServerSocket.t port)
131  (new Transport.factory)
132  pf
133  pf
134in
135  server#serve
136
137
138