diff options
| author | Stephen Dolan <stephen.dolan@cl.cam.ac.uk> | 2017-09-15 16:38:27 +0100 |
|---|---|---|
| committer | Stephen Dolan <stephen.dolan@cl.cam.ac.uk> | 2017-10-05 16:54:10 +0100 |
| commit | 7ed63d4ff3990dd9b699290b3b0243847202a5c6 (patch) | |
| tree | 38cd88b4d378cac30a49cd270c7db55af344eaf5 | |
| parent | 689ac00ce1e55aa066f3b541729f2cb3216ada86 (diff) | |
| download | ocaml-7ed63d4ff3990dd9b699290b3b0243847202a5c6.tar.gz | |
afl-fuzz instrumentation fix for classes.
Disable class initialisation cache when compiling with afl-fuzz
instrumentation enabled. See MPR#7612
| -rw-r--r-- | bytecomp/translclass.ml | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml index a790f320f9..d5ffd33919 100644 --- a/bytecomp/translclass.ml +++ b/bytecomp/translclass.ml @@ -843,16 +843,23 @@ let transl_class ids cl_id pub_meths cl vflag = loc = Location.none; params = [cla]; body = def_ids cla cl_init}) in + let lupdate_cache = + if ids = [] then ldirect () else + if not concrete then lclass_virt () else + lclass ( + mkappl (oo_prim "make_class_store", + [transl_meth_list pub_meths; + Lvar class_init; Lvar cached])) in + let lcheck_cache = + if !Clflags.native_code && !Clflags.afl_instrument then + (* When afl-fuzz instrumentation is enabled, ignore the cache + so that the program's behaviour does not change between runs *) + lupdate_cache + else + Lifthenelse(lfield cached 0, lambda_unit, lupdate_cache) in llets ( lcache ( - Lsequence( - Lifthenelse(lfield cached 0, lambda_unit, - if ids = [] then ldirect () else - if not concrete then lclass_virt () else - lclass ( - mkappl (oo_prim "make_class_store", - [transl_meth_list pub_meths; - Lvar class_init; Lvar cached]))), + Lsequence(lcheck_cache, make_envs ( if ids = [] then mkappl (lfield cached 0, [lenvs]) else Lprim(Pmakeblock(0, Immutable, None), |