File: test_option_array_allocation.ml

package info (click to toggle)
janest-base 0.17.3-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 3,632 kB
  • sloc: ml: 48,653; ansic: 281; javascript: 126; makefile: 14
file content (58 lines) | stat: -rw-r--r-- 1,805 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
open! Base
open Option_array
open Expect_test_helpers_core

let () =
  let t = of_array [| None |] in
  assert (
    require_no_allocation [%here] (fun () ->
      match get t 0 with
      | None -> true
      | Some _ -> false))
;;

let () =
  let t = of_array [| Some 0 |] in
  let get_some () =
    match get t 0 with
    | None -> false
    | Some _ -> true
  in
  (* After inlining, [match get t 0 with] is:

     {[
       match
         let cheap_option = Uniform_array.get t 0 in
         if Cheap_option.is_some cheap_option
         then Some (Cheap_option.value_unsafe cheap_option)
         else None
       with
     ]}

     This situation is called "match-in-match" (the inner [if] is essentially a match).
     The OCaml compiler and Flambda optimizer don't handle match-in-match well, and so
     cannot eliminate the allocation of [Some].  Flambda2 is expected to eliminate the
     allocation, at which point we can [require_no_allocation] (possibly annotating the
     test with [@tags "fast-flambda"]).

     Note that Flambda 2 only eliminates the allocation in optimized mode.
     In classic mode, it will remain.  This file is compiled with optimized mode.
  *)
  let compiler_eliminates_the_allocation =
    (* [Version_util.x_library_inlining] is the whole reason this is a separate
       executable. *)
    Config.flambda2 && Version_util.x_library_inlining
  in
  if compiler_eliminates_the_allocation
  then assert (require_no_allocation [%here] get_some)
  else
    let module Gc = Core.Gc.For_testing in
    let _, { Gc.Allocation_report.minor_words_allocated; _ } =
      Gc.measure_allocation get_some
    in
    if minor_words_allocated <= 2
    then ()
    else
      failwith
        (Printf.sprintf "Allocated more words than expected: %d" minor_words_allocated)
;;