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   (* doesn't work, see https://github.com/curl/curl/issues/2551 *)
  17 (*   let g = duphandle h in *)
  18   let g = init () in
  19   cleanup h;
  20   cleanup g
  21
  22 let rss () =
  23   let path = Printf.sprintf "/proc/%d/statm" (Unix.getpid ()) in
  24   try
  25     let ch = open_in path in
  26     let n = Scanf.fscanf ch "%_d %d" (fun x -> 4*1024*x) in close_in_noerr ch; n
  27   with exn -> Printf.eprintf "Error opening %s (%s), ignoring\n%!" path (Printexc.to_string exn); 0
  28
  29 let check test count leak_size =
  30   try
  31     let rss1 = rss () in
  32     for i = 0 to pred count do
  33       test leak_size;
  34       Gc.compact ();
  35     done;
  36     let rss2 = rss () in
  37     Printf.printf "RSS %d -> %d %s\n%!" rss1 rss2 (if rss2 - rss1 < count * leak_size / 10 then "OK" else "LEAKING")
  38   with
  39     Curl.NotImplemented s -> Printf.printf "skipping test : libcurl doesn't provide %s\n%!" s
  40
  41 let () =
  42   let mb = 1024 * 1024 in
  43   check test1 200 mb;
  44   check test2 100 mb;
  45   ()