diff options
| author | Pierre-Marie Pédrot | 2018-07-20 12:03:27 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2018-07-20 12:09:34 +0200 |
| commit | 8e88da289d5c96506a9540890ccbd7c22570049c (patch) | |
| tree | 62b33fbac36672ea0f82fefc6871b7f54cbd2318 | |
| parent | d8cd9ba6d56d32eb8aa383bca9198a18517e82d3 (diff) | |
Fix #8043: Unsafe assignment in checker.
We use a dedicated mutable constructor to perform a Landin knot.
| -rw-r--r-- | checker/validate.ml | 1 | ||||
| -rw-r--r-- | checker/values.ml | 15 | ||||
| -rw-r--r-- | checker/values.mli | 1 |
3 files changed, 12 insertions, 5 deletions
diff --git a/checker/validate.ml b/checker/validate.ml index f831875dd4..c214409a2c 100644 --- a/checker/validate.ml +++ b/checker/validate.ml @@ -85,6 +85,7 @@ let rec val_gen v ctx o = match v with | Fail s -> fail ctx o ("unexpected object " ^ s) | Annot (s,v) -> val_gen v (ctx/CtxAnnot s) o | Dyn -> val_dyn ctx o + | Proxy { contents = v } -> val_gen v ctx o (* Check that an object is a tuple (or a record). vs is an array of value representation for each field. Its size corresponds to the diff --git a/checker/values.ml b/checker/values.ml index 88cdb644db..d81b0f474a 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -45,6 +45,13 @@ type value = | String | Annot of string * value | Dyn + | Proxy of value ref + +let fix (f : value -> value) : value = + let self = ref Any in + let ans = f (Proxy self) in + let () = self := ans in + ans (** Some pseudo-constructors *) @@ -352,18 +359,16 @@ let v_states = v_pair Any v_frozen let v_state = Tuple ("state", [|v_states; Any; v_bool|]) let v_vcs = - let data = Opt Any in - let vcs = + let vcs self = Tuple ("vcs", [|Any; Any; Tuple ("dag", [|Any; Any; v_map Any (Tuple ("state_info", - [|Any; Any; Opt v_state; v_pair data Any|])) + [|Any; Any; Opt v_state; v_pair (Opt self) Any|])) |]) |]) in - let () = Obj.set_field (Obj.magic data) 0 (Obj.magic vcs) in - vcs + fix vcs let v_uuid = Any let v_request id doc = diff --git a/checker/values.mli b/checker/values.mli index 20b9d54a68..1b1437a469 100644 --- a/checker/values.mli +++ b/checker/values.mli @@ -20,6 +20,7 @@ type value = | String | Annot of string * value | Dyn + | Proxy of value ref val v_univopaques : value val v_libsum : value |