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