(* Copyright (C) 2025 Petter A. Urkedal * * This library is free software; you can redistribute it and/or modify it * under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or (at your * option) any later version, with the LGPL-3.0 Linking Exception. * * This library is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public * License for more details. * * You should have received a copy of the GNU Lesser General Public License * and the LGPL-3.0 Linking Exception along with this library. If not, see * and , respectively. *) open Caqti_template open Caqti_platform module A = Alcotest.V1 module Cache = Request_cache.Make (struct type t = int let weight _ = 1 end) let dialect = Dialect.create_unknown ~purpose:`Dummy () [@alert "-caqti_private"] let static_select = let open Caqti_template.Create in static T.(unit -->! int) "SELECT -1" let dynamic_select i = let open Caqti_template.Create in let query = Q.("SELECT " ^++ int i) in let request_type = T.(unit -->! int) in Request.create Dynamic request_type (fun _ -> query) let is_promoted i = Hashtbl.hash (i : int) land 1 = 0 let is_retained i = Hashtbl.hash (i : int) land 2 = 0 let is_orphaned i = not (is_promoted i || is_retained i) let test_hit_or_miss () = let n = 1000 in let all = List.init n Fun.id in let promoted = List.filter is_promoted all in let retained = List.filter is_retained all in let orphaned = List.filter is_orphaned all in let retained_requests = Queue.create () in let dynamic_capacity = n - List.length orphaned in let cache = Cache.create ~dynamic_capacity dialect in Cache.add cache static_select (-1); let promote_upto j = promoted |> List.iter begin fun i -> if i < j then let elt = Cache.find_and_promote cache (dynamic_select i) in A.(check (option int)) "promote" (Some i) elt end in for i = 0 to n - 1 do if i < dynamic_capacity then A.(check int) "weight" i (Cache.dynamic_weight cache); let request = dynamic_select i in if is_retained i then Queue.add request retained_requests; Cache.add cache request i; if is_orphaned i then promote_upto i done; (* The second Gc.compact call is needed for OCaml 5.0.0 and 5.1.1. *) Gc.compact (); Gc.compact (); let trimmed, commit = Cache.trim ~max_promote_count:n cache in A.(check (list int)) "trim" orphaned (List.sort Int.compare trimmed); commit (); retained |> List.iter begin fun i -> A.(check (option int)) "retained dynamic hit" (Some i) (Cache.find_and_promote cache (dynamic_select i)) end; promoted |> List.iter begin fun i -> A.(check (option int)) "dynamic hit" (Some i) (Cache.find_and_promote cache (dynamic_select i)) end; orphaned |> List.iter begin fun i -> A.(check (option int)) "dynamic miss" None (Cache.find_and_promote cache (dynamic_select i)) end; A.(check (option int)) "static hit" (Some (-1)) (Cache.find_and_promote cache static_select); ignore (Queue.iter ignore retained_requests) let test_cases = [ A.test_case "hit or miss" `Quick test_hit_or_miss; ]