diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2011-12-20 10:42:36 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2011-12-20 10:42:36 +0000 |
| commit | a40d0432b2ff93e0a888d26014b3897fa5a0d27f (patch) | |
| tree | a2f6fc8f92144b0fc346dbce7ce8db2ee9716cd0 | |
| parent | c1f154ea70799d116e652de0c7bb507b8a373b2a (diff) | |
PR#4880: added appropriate event to "assert" so that it shows up properly in stack backtraces
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11891 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | bytecomp/translcore.ml | 14 |
2 files changed, 9 insertions, 6 deletions
@@ -36,6 +36,7 @@ Bug Fixes: - PR#5343: ocaml -rectypes is unsound wrt module subtyping - PR#5322: type abbreviations expanding to a universal type variable - PR#5330: thread tag with '.top' and '.inferred.mli' targets +- PR#4880: "assert" constructs now show up in the exception stack backtrace - PR#4869: rare collisions between assembly labels for code and data Feature wishes: diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 8fb005f17..edf24e4b8 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -532,14 +532,16 @@ let primitive_is_ccall = function (* Assertions *) -let assert_failed loc = - let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in - Lprim(Praise, [Lprim(Pmakeblock(0, Immutable), +let assert_failed exp = + let (fname, line, char) = + Location.get_pos_info exp.exp_loc.Location.loc_start in + Lprim(Praise, [event_after exp + (Lprim(Pmakeblock(0, Immutable), [transl_path Predef.path_assert_failure; Lconst(Const_block(0, [Const_base(Const_string fname); Const_base(Const_int line); - Const_base(Const_int char)]))])]) + Const_base(Const_int char)]))]))]) ;; let rec cut n l = @@ -762,8 +764,8 @@ and transl_exp0 e = | Texp_assert (cond) -> if !Clflags.noassert then lambda_unit - else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e.exp_loc) - | Texp_assertfalse -> assert_failed e.exp_loc + else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e) + | Texp_assertfalse -> assert_failed e | Texp_lazy e -> (* when e needs no computation (constants, identifiers, ...), we optimize the translation just as Lazy.lazy_from_val would |