a database layer insipred by caqti and ecto
gdiazlo.tngl.sh
1open Repodb
2
3type mock_conn = { id : int; mutable closed : bool }
4
5let conn_counter = Atomic.make 0
6
7let mock_config ?(max_size = 3) ?(fail_connect = false) ?(validate = None) () =
8 Pool.
9 {
10 max_size;
11 connect =
12 (fun () ->
13 if fail_connect then Error "Connection failed"
14 else
15 let id = Atomic.fetch_and_add conn_counter 1 in
16 Ok { id; closed = false });
17 close = (fun conn -> conn.closed <- true);
18 validate;
19 }
20
21let test_create_pool () =
22 let pool = Pool.create (mock_config ()) in
23 Alcotest.(check int) "initial size" 0 (Pool.size pool);
24 Alcotest.(check int) "initial available" 0 (Pool.available pool);
25 Alcotest.(check int) "initial in_use" 0 (Pool.in_use pool);
26 Alcotest.(check bool) "not closed" false (Pool.is_closed pool)
27
28let test_acquire_creates_connection () =
29 let pool = Pool.create (mock_config ()) in
30 match Pool.acquire pool with
31 | Ok conn ->
32 Alcotest.(check int) "total is 1" 1 (Pool.size pool);
33 Alcotest.(check int) "in_use is 1" 1 (Pool.in_use pool);
34 Alcotest.(check bool) "conn not closed" false conn.closed;
35 Pool.release pool conn
36 | Error _ -> Alcotest.fail "Expected successful acquire"
37
38let test_release_returns_to_pool () =
39 let pool = Pool.create (mock_config ()) in
40 match Pool.acquire pool with
41 | Ok conn ->
42 Pool.release pool conn;
43 Alcotest.(check int) "available is 1" 1 (Pool.available pool);
44 Alcotest.(check int) "in_use is 0" 0 (Pool.in_use pool)
45 | Error _ -> Alcotest.fail "Expected successful acquire"
46
47let test_acquire_reuses_connection () =
48 let pool = Pool.create (mock_config ()) in
49 let conn1 =
50 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
51 in
52 let id1 = conn1.id in
53 Pool.release pool conn1;
54 let conn2 =
55 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
56 in
57 Alcotest.(check int) "same connection reused" id1 conn2.id;
58 Alcotest.(check int) "still only 1 total" 1 (Pool.size pool);
59 Pool.release pool conn2
60
61let test_max_size_enforced () =
62 let pool = Pool.create (mock_config ~max_size:2 ()) in
63 let c1 =
64 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
65 in
66 let c2 =
67 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
68 in
69 (match Pool.acquire pool with
70 | Error Pool.Pool_empty -> ()
71 | _ -> Alcotest.fail "Expected Pool_empty");
72 Pool.release pool c1;
73 Pool.release pool c2
74
75let test_with_connection () =
76 let pool = Pool.create (mock_config ()) in
77 let result =
78 Pool.with_connection pool (fun conn ->
79 Alcotest.(check int) "in_use during work" 1 (Pool.in_use pool);
80 conn.id + 100)
81 in
82 match result with
83 | Ok n ->
84 Alcotest.(check bool) "got result" true (n >= 100);
85 Alcotest.(check int) "released after" 0 (Pool.in_use pool)
86 | Error _ -> Alcotest.fail "Expected successful with_connection"
87
88let test_with_connection_releases_on_exception () =
89 let pool = Pool.create (mock_config ()) in
90 (try
91 let _ =
92 Pool.with_connection pool (fun _ ->
93 Alcotest.(check int) "in_use" 1 (Pool.in_use pool);
94 failwith "boom")
95 in
96 ()
97 with Failure _ -> ());
98 Alcotest.(check int) "released after exception" 0 (Pool.in_use pool)
99
100let test_connection_error () =
101 let pool = Pool.create (mock_config ~fail_connect:true ()) in
102 match Pool.acquire pool with
103 | Error (Pool.Connection_error msg) ->
104 Alcotest.(check string) "error message" "Connection failed" msg
105 | _ -> Alcotest.fail "Expected Connection_error"
106
107let test_validation () =
108 let call_count = ref 0 in
109 let validate conn =
110 incr call_count;
111 not conn.closed
112 in
113 let pool = Pool.create (mock_config ~validate:(Some validate) ()) in
114 let conn =
115 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
116 in
117 Pool.release pool conn;
118 let _ =
119 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
120 in
121 Alcotest.(check bool) "validate called" true (!call_count > 0)
122
123let test_shutdown () =
124 let pool = Pool.create (mock_config ()) in
125 let conn =
126 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
127 in
128 Pool.release pool conn;
129 Pool.shutdown pool;
130 Alcotest.(check bool) "pool closed" true (Pool.is_closed pool);
131 match Pool.acquire pool with
132 | Error Pool.Pool_closed -> ()
133 | _ -> Alcotest.fail "Expected Pool_closed"
134
135let test_drain () =
136 let pool = Pool.create (mock_config ()) in
137 let c1 =
138 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
139 in
140 let c2 =
141 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
142 in
143 Pool.release pool c1;
144 Pool.release pool c2;
145 Alcotest.(check int) "2 available before drain" 2 (Pool.available pool);
146 Pool.drain pool;
147 Alcotest.(check int) "0 available after drain" 0 (Pool.available pool);
148 Alcotest.(check int) "0 total after drain" 0 (Pool.size pool)
149
150let test_stats () =
151 let pool = Pool.create (mock_config ~max_size:5 ()) in
152 let conn =
153 match Pool.acquire pool with Ok c -> c | Error _ -> Alcotest.fail "fail"
154 in
155 let stats = Pool.stats pool in
156 Alcotest.(check int) "stats.total" 1 stats.total;
157 Alcotest.(check int) "stats.in_use" 1 stats.in_use;
158 Alcotest.(check int) "stats.available" 0 stats.available;
159 Alcotest.(check bool) "stats.closed" false stats.closed;
160 Pool.release pool conn
161
162let test_error_to_string () =
163 Alcotest.(check string)
164 "Pool_empty" "Pool empty: no connections available"
165 (Pool.error_to_string Pool.Pool_empty);
166 Alcotest.(check string)
167 "Pool_closed" "Pool closed"
168 (Pool.error_to_string Pool.Pool_closed);
169 Alcotest.(check string)
170 "Pool_timeout" "Timeout waiting for connection"
171 (Pool.error_to_string Pool.Pool_timeout);
172 Alcotest.(check string)
173 "Connection_error" "Connection error: oops"
174 (Pool.error_to_string (Pool.Connection_error "oops"))
175
176let tests =
177 [
178 ("create pool", `Quick, test_create_pool);
179 ("acquire creates connection", `Quick, test_acquire_creates_connection);
180 ("release returns to pool", `Quick, test_release_returns_to_pool);
181 ("acquire reuses connection", `Quick, test_acquire_reuses_connection);
182 ("max size enforced", `Quick, test_max_size_enforced);
183 ("with_connection", `Quick, test_with_connection);
184 ( "with_connection releases on exception",
185 `Quick,
186 test_with_connection_releases_on_exception );
187 ("connection error", `Quick, test_connection_error);
188 ("validation", `Quick, test_validation);
189 ("shutdown", `Quick, test_shutdown);
190 ("drain", `Quick, test_drain);
191 ("stats", `Quick, test_stats);
192 ("error_to_string", `Quick, test_error_to_string);
193 ]