examples/test_memory_leaks.ml

   1 open Curl
   2
   3 let test1 size =
   4   let h = init () in
   5   let s1 = String.make size 'd' in
   6   set_private h s1;
   7   let s2 = String.make size 'c' in
   8   set_httppost h [CURLFORM_CONTENT ("part", s2, DEFAULT)];
   9   assert (get_private h = s1);
  10   cleanup h
  11
  12 let test2 size =
  13   let h = init () in
  14   let s = String.make size 'a' in
  15   set_mimepost h [{encoding=CURLMIME_BINARY;headers=[];subparts=[];data=CURLMIME_DATA s}];
  16   (* see https://github.com/curl/curl/issues/2551 *)
  17   let g = if (version_info ()).number >= (7,58,0) then duphandle h else init () in
  18   cleanup h;
  19   cleanup g
  20
  21 let rss () =
  22   let path = Printf.sprintf "/proc/%d/statm" (Unix.getpid ()) in
  23   try
  24     let ch = open_in path in
  25     let n = Scanf.fscanf ch "%_d %d" (fun x -> 4*1024*x) in close_in_noerr ch; n
  26   with exn -> Printf.eprintf "Error opening %s (%s), ignoring\n%!" path (Printexc.to_string exn); 0
  27
  28 let check test count leak_size =
  29   try
  30     let rss1 = rss () in
  31     for i = 0 to pred count do
  32       test leak_size;
  33       Gc.compact ();
  34     done;
  35     let rss2 = rss () in
  36     Printf.printf "RSS %d -> %d %s\n%!" rss1 rss2 (if rss2 - rss1 < count * leak_size / 10 then "OK" else "LEAKING")
  37   with
  38     Curl.NotImplemented s -> Printf.printf "skipping test : libcurl doesn't provide %s\n%!" s
  39
  40 let () =
  41   let mb = 1024 * 1024 in
  42   check test1 200 mb;
  43   check test2 100 mb;
  44   ()