diff options
| author | Maxime Dénès | 2020-04-14 19:55:06 +0200 |
|---|---|---|
| committer | Maxime Dénès | 2020-04-14 19:55:06 +0200 |
| commit | d1bc21a386a814fe86c0ebac58088ce65d015587 (patch) | |
| tree | e3895b8de9652ce8032e9dd1ee57b1c0ff084611 /checker | |
| parent | 7bfdd65398139398a6495fb97ed1ee9383f1606d (diff) | |
| parent | dae0e2614139c91262d3c4afe3587c9acfc5d05e (diff) | |
Merge PR #11820: Partial imports
Reviewed-by: Zimmi48
Reviewed-by: jfehrle
Reviewed-by: maximedenes
Ack-by: ppedrot
Diffstat (limited to 'checker')
| -rw-r--r-- | checker/check.ml | 2 | ||||
| -rw-r--r-- | checker/validate.ml | 9 | ||||
| -rw-r--r-- | checker/validate.mli | 2 | ||||
| -rw-r--r-- | checker/values.ml | 13 |
4 files changed, 18 insertions, 8 deletions
diff --git a/checker/check.ml b/checker/check.ml index bb3255338f..4212aac6ea 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -305,7 +305,7 @@ let marshal_in_segment ~validate ~value f ch = with _ -> user_err (str "Corrupted file " ++ quote (str f)) in - let () = Validate.validate ~debug:!Flags.debug value v in + let () = Validate.validate value v in let v = Analyze.instantiate v in Obj.obj v, stop, digest else diff --git a/checker/validate.ml b/checker/validate.ml index 66367cb002..20884c4d01 100644 --- a/checker/validate.ml +++ b/checker/validate.ml @@ -208,11 +208,10 @@ let print_frame = function | CtxField i -> Printf.sprintf "fld=%i" i | CtxTag i -> Printf.sprintf "tag=%i" i -let validate ~debug v (o, mem) = +let validate v (o, mem) = try val_gen v mem mt_ec o with ValidObjError(msg,ctx,obj) -> - (if debug then - let ctx = List.rev_map print_frame ctx in - print_endline ("Context: "^String.concat"/"ctx); - pr_obj mem obj); + let rctx = List.rev_map print_frame ctx in + print_endline ("Context: "^String.concat"/"rctx); + pr_obj mem obj; failwith ("Validation failed: "^msg^" (in "^(print_frame (List.hd ctx))^")") diff --git a/checker/validate.mli b/checker/validate.mli index 9ddc510e4a..1204b528f9 100644 --- a/checker/validate.mli +++ b/checker/validate.mli @@ -10,4 +10,4 @@ open Analyze -val validate : debug:bool -> Values.value -> data * obj LargeArray.t -> unit +val validate : Values.value -> data * obj LargeArray.t -> unit diff --git a/checker/values.ml b/checker/values.ml index 12f7135cdf..b9efce6948 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -372,6 +372,17 @@ let v_compiled_lib = let v_obj = Dyn +let v_globref = Sum("globref",0,[| + [|v_id|]; + [|v_cst|]; + [|v_ind|]; + [|v_cons|] + |]) + +let v_ext_gref = Sum("extended_global_reference",0,[|[|v_globref|];[|v_kn|]|]) + +let v_open_filter = Sum ("open_filter",1,[|[|v_hset v_ext_gref|]|]) + let rec v_aobjs = Sum("algebraic_objects", 0, [| [|v_libobjs|]; [|v_mp;v_subst|] @@ -383,7 +394,7 @@ and v_libobjt = Sum("Libobject.t",0, [| v_substobjs |]; [| v_aobjs |]; [| v_libobjs |]; - [| List v_mp |]; + [| List (v_pair v_open_filter v_mp)|]; [| v_obj |] |]) |