2

以下示例在针对 x86 或 x64 时运行良好。但是，当针对 x64（但不是 x86！）时，它会立即使 VS2012 分析器崩溃，并导致缓冲区溢出。如果我将类型 Foo 切换为 int，它可以正常工作，但是一旦我使用记录，它就会失败。有任何想法吗？

open System

module Binary =

    open System.Reflection
    open Microsoft.FSharp.Reflection

    let private flags =
        BindingFlags.Public ||| BindingFlags.NonPublic

    type BinaryReadWriter<'a> =
        { Reader : IO.BinaryReader -> 'a
          Writer : IO.BinaryWriter -> 'a -> unit
        }

    type Reader = (IO.BinaryReader -> obj)
    type Writer = (IO.BinaryWriter -> obj -> unit)

    let rec private readValue (t: Type) : Reader =
        if   t = typeof<int>               then fun r -> box (r.ReadInt32())
        elif FSharpType.IsRecord(t, flags) then let readers = [| for f in FSharpType.GetRecordFields(t, flags) -> readValue f.PropertyType |]
                                                let build = FSharpValue.PreComputeRecordConstructor(t, flags)
                                                fun r -> readers |> Array.map (fun reader -> reader r) |> build
        else
            failwithf "Unsupported type: %s" t.Name

    let rec private writeValue (t: Type) : Writer =
        if   t = typeof<int>               then fun w v -> w.Write(v :?> int)
        elif FSharpType.IsRecord(t, flags) then let writers = [| for f in FSharpType.GetRecordFields(t, flags) -> writeValue f.PropertyType |]
                                                let getBits = FSharpValue.PreComputeRecordReader(t, flags)
                                                fun w v -> getBits v |> Array.iter2 (fun wi vi -> wi w vi) writers
        else
            failwithf "Unsupported type: %s" t.Name

    let binaryReadWriter<'a> () : BinaryReadWriter<'a> =
        let reader = readValue  typeof<'a>
        let writer = writeValue typeof<'a>
        { Reader = reader >> unbox
          Writer = fun w -> box >> writer w
        }

type Foo =
    { Bar : int }

[<EntryPoint>]
let main _ = 

    // The following code crashes VS2012 profiler when running as a 64 bit process, but 
    // profiles fine when running as a 32 bit process.

    let binary = Binary.binaryReadWriter<Foo>()        

    let value = { Bar = 0 }

    while true do
        use mem = new IO.MemoryStream()
        use write = new IO.BinaryWriter(mem)
        binary.Writer write value
        let _ = mem.Seek(0L, IO.SeekOrigin.Begin)
        use read = new IO.BinaryReader(mem)
        binary.Reader read |> ignore
    0

异常消息是

A buffer overrun has occurred in test.exe which has corrupted the program's internal state. Press Break to debug the program or Continue to terminate the program.

引发异常时的调用堆栈为：

clr.dll!__crt_debugger_hook()   Unknown
clr.dll!__raise_securityfailure()   Unknown
clr.dll!__report_gsfailure()    Unknown
clr.dll!StackFrameIterator::Init(class Thread *,class Frame *,struct REGDISPLAY *,unsigned int) Unknown
clr.dll!Thread::StackWalkFramesEx(struct REGDISPLAY *,enum StackWalkAction (*)(class CrawlFrame *,void *),void *,unsigned int,class Frame *)    Unknown
clr.dll!Thread::StackWalkFrames(enum StackWalkAction (*)(class CrawlFrame *,void *),void *,unsigned int,class Frame *)  Unknown
clr.dll!ProfToEEInterfaceImpl::ProfilerStackWalkFramesWrapper(class Thread *,struct _PROFILER_STACK_WALK_DATA *,unsigned int)   Unknown
clr.dll!ProfToEEInterfaceImpl::DoStackSnapshotHelper(class Thread *,struct _PROFILER_STACK_WALK_DATA *,unsigned int,struct _CONTEXT *)  Unknown
clr.dll!ProfToEEInterfaceImpl::DoStackSnapshot(unsigned __int64,long (*)(unsigned __int64,unsigned __int64,unsigned __int64,unsigned int,unsigned char * const,void *),unsigned int,void *,unsigned char *,unsigned int)    Unknown
VSPerfCorProf.dll!IsStackWalkSafe(void) Unknown
SamplingRuntime.dll!IsStackWalkSafe()   Unknown
SamplingRuntime.dll!GetStack()  Unknown
SamplingRuntime.dll!ProcessSample() Unknown
SamplingRuntime.dll!GetSample() Unknown
4

0 回答 0