summaryrefslogtreecommitdiff
path: root/testsuite/tests/utils/magic_number.ml
blob: a443e253e5bc4d149e7fa3bc901d0ac484766248 (plain)
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
(* TEST
include config
binary_modules = "config build_path_prefix_map misc"
* bytecode
*)

open Misc
open Magic_number

(* sanity checking: the magic number at a given kind can be parsed back *)
let error kind test =
  fatal_errorf
    "Internal compiler error (%s): there is a magic number mismatch on kind %s"
    test
    (string_of_kind kind)

let check_raw_kind kind =
  let valid =
    match parse_kind (raw_kind kind) with
      | None -> false
      | Some kind_roundtrip ->
         kind_roundtrip = kind
  in
  if not valid then error kind "raw_kind"

let check_current_raw kind =
  let valid =
    match parse (current_raw kind) with
      | Error _ -> false
      | Ok magic ->
         magic.kind = kind
         && raw magic = current_raw kind
  in
  if not valid then error kind "current_raw"

let () =
  all_kinds
  |> List.iter (fun kind -> check_raw_kind kind; check_current_raw kind)