[MLton-user] Finalizable bug

[Florian Weimer]

* Sean McLaughlin:

>   I found a bug using the Finalizer module.  The tar of the files is
> attached.
> On multiple machines it gave segfaults.

The references to MLton.Pointer are not necessary, so it's possible to
minimize the test case even further.  The crash occurs in the
mark-compact collector during the first mark-compact collection of this
program.  A backtrace with the debugging run-time library looks like
this:
#0  copyForThreadInternal (dst=0x2afda37c3ac4 "", src=0x0) at
 gc/mark-compact.c:39
#1  0x0000000000420f31 in updateBackwardPointersAndSlideForMarkCompact
 (s=0x6379e0)
    at gc/mark-compact.c:263
#2  0x00000000004226f9 in majorMarkCompactGC (s=0x6379e0) at
 gc/mark-compact.c:306
#3  0x0000000000423985 in majorGC (s=0x6379e0, bytesRequested=512,
 mayResize=true)
    at gc/garbage-collection.c:34
#4  0x0000000000423d6c in performGC (s=0x6379e0, oldGenBytesRequested=0,
    nurseryBytesRequested=512, forceMajor=false, mayResize=false)
    at gc/garbage-collection.c:142
#5  0x0000000000424917 in ensureInvariantForMutator (s=0x6379e0,
 force=true)
    at gc/garbage-collection.c:196
#6  0x00000000004249b4 in GC_collect (s=0x6379e0, bytesRequested=512,
 force=true,
    file=0x0, line=0) at gc/garbage-collection.c:226
#7  0x000000000040ed8f in loop_31 ()
#8  0x0000000000000000 in ?? ()

structure Bug =
struct 

  structure F = MLton.Finalizable

  fun new_t () =
      let 
        val p = 0
        val t = F.new p
        fun finalize x = ()
      in
        F.addFinalizer(t,finalize);
        t
      end

  fun from_string (_:string) = 
      let
        val x = new_t ()
      in
        F.withValue(x,fn p => ());
        x
      end

  val zero = from_string "0.0"


  (* NOTE: I removed the F.withValue lines in an attempt to make the
   code simpler, but the bug didn't manifest itself.  So I think these
   lines are critical. *)
  fun plus (x,y) = 
      let
        val z = new_t ()
      in
        F.withValue(x,fn xp => 
          F.withValue(y,fn yp => 
            F.withValue(z,fn zp => 
              let in
                z
              end)))
      end

end
 
structure B = Bug

fun bigsum (n,store) =
    if n = 0 then store else
    let 
      val _ = if Int.mod(n,10000) = 0 then print (Int.toString n ^ "\n") else () 
    in
      bigsum(Int.-(n,1),B.plus(store,B.from_string(Int.toString n ^ ".0")))
    end

val bigsum = (fn n => bigsum(n,B.zero))

val x = bigsum 10000000