Original bug ID: 6686
Reporter: @mshinwell
Assigned to: @mshinwell
Status: closed (set by @xavierleroy on 2016-12-07T10:48:55Z)
Resolution: fixed
Priority: high
Severity: crash
Version: 4.02.1
Target version: 4.02.2+dev / +rc1
Fixed in version: 4.02.2+dev / +rc1
Category: back end (clambda to assembly)
Has duplicate: #6770
Monitored by: @diml @jmeber

Bug description

The test in the following patch fails on 4.02.1, with -inline 2.

Fatal error: Selection.emit_expr: unbound var match_1022
Fatal error: exception Misc.Fatal_error

This appears to be happening because subst_boxed_number has two cases (for Cload) that match on patterns involving Cvar nodes---but in the event of them being unable to unbox, they do not execute the logic contained in the normal Cvar case, namely setting [need_boxed] to [true]. This can leave accesses to boxed variables without a corresponding binding of the variable in question.

The patch below also adds an exhaustive match here, since this is quite subtle. There is a new variable ADD_OPTCOMPFLAGS to permit tests that use compiler options that are not present for the bytecode compiler.

Xavier, if this looks ok, I will commit.

Bug report by Ben Millwood.
Patch by Jérémie Dimino and Mark Shinwell.

Steps to reproduce

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 1f640b9..7c7065d 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1254,13 +1254,21 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp =
Cassign(id, subst arg)
| Ctuple argv -> Ctuple(List.map subst argv)
| Cop(Cload chunk, [Cvar id]) as e ->

•    if Ident.same id boxed_id && chunk = box_chunk && box_offset = 0
  

•    then Cvar unboxed_id
  

•    else e
  

•    if not (Ident.same id boxed_id) then e
  

•    else if chunk = box_chunk && box_offset = 0 then
  

•      Cvar unboxed_id
  

•    else begin
  

•      need_boxed := true;
  

•      e
  

•    end
  
  | Cop(Cload chunk, [Cop(Cadda, [Cvar id; Cconst_int ofs])]) as e ->

•    if Ident.same id boxed_id && chunk = box_chunk && ofs = box_offset
  

•    then Cvar unboxed_id
  

•    else e
  

•    if not (Ident.same id boxed_id) then e
  

•    else if chunk = box_chunk && ofs = box_offset then
  

•      Cvar unboxed_id
  

•    else begin
  

•      need_boxed := true;
  

•      e
  

•    end
  
  | Cop(op, argv) -> Cop(op, List.map subst argv)
  | Csequence(e1, e2) -> Csequence(subst e1, subst e2)
  | Cifthenelse(e1, e2, e3) -> Cifthenelse(subst e1, subst e2, subst e3)
  @@ -1270,7 +1278,10 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp =
  | Ccatch(nfail, ids, e1, e2) -> Ccatch(nfail, ids, subst e1, subst e2)
  | Cexit (nfail, el) -> Cexit (nfail, List.map subst el)
  | Ctrywith(e1, id, e2) -> Ctrywith(subst e1, id, subst e2)

• | e -> e in

• | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
• | Cconst_pointer _ | Cconst_natpointer _
• | Cconst_blockheader _ as e -> e
• in
  let res = subst exp in
  (res, !need_boxed, !assigned)

diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one
index 9f95b36..6a5f5c8 100644
--- a/testsuite/makefiles/Makefile.one
+++ b/testsuite/makefiles/Makefile.one
@@ -48,7 +48,8 @@ compile: $(M{L}_{F}ILES)$(CMO_FILES) $(MAIN_MODULE).cmo
@if $(BYTECODE_ONLY); then : ; else
rm -f program.native program.native.exe;
$(MAKE)$(CMX_FILES) $(MAIN_MODULE).cmx; \

• $(OCAMLOPT) $(ADD_COMPFLAGS) -o program.native$(EXE) $(O_FILES) \
  

• $(OCAMLOPT) $(ADD_COMPFLAGS) $(ADD_OPTCOMPFLAGS) \
  

•                  -o program.native$(EXE) $(O_FILES) \
              $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \
              $(MAIN_MODULE).cmx; \
  
  fi
  diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
  new file mode 100644
  index 0000000..44271b6
  --- /dev/null
  +++ b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
  @@ -0,0 +1,9 @@
  +type t =
• | A of float
• | B of (int * int)

+let rec foo = function

• | A x -> x
• | B (x, y) -> float x +. float y

+let (_ : float) = foo (A 4.)
diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.reference b/testsuite/tests/float-unboxing/float_subst_boxed_number.reference
new file mode 100644
index 0000000..e69de29

File attachments

• 6670.html