From b456cecba869065ab8488e53583598dd672c61a3 Mon Sep 17 00:00:00 2001
From: Adam Boniecki <20281641+abonie@users.noreply.github.com>
Date: Fri, 19 May 2023 20:11:55 +0200
Subject: [PATCH] Fix pretty print error for pointer type (#15207)

* Fix by casting Void* to nativeint

Special-case for System.Reflection.Pointer

* Add test

Modifies test framework to add stdout to `runFsi`

---------

Co-authored-by: Adam Boniecki <adboniec@microsoft.com>
---
 src/Compiler/Interactive/fsi.fs               | 23 ++++++++++++++++---
 .../Scripting/Interactive.fs                  |  7 ++++++
 tests/FSharp.Test.Utilities/Compiler.fs       |  7 ++++--
 tests/FSharp.Test.Utilities/CompilerAssert.fs |  4 ++--
 4 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs
index 77c570b14e..1c7e7bcd2a 100644
--- a/src/Compiler/Interactive/fsi.fs
+++ b/src/Compiler/Interactive/fsi.fs
@@ -6,6 +6,7 @@ module FSharp.Compiler.Interactive.Shell
 #nowarn "57"
 
 #nowarn "55"
+#nowarn "9"
 
 [<assembly: System.Runtime.InteropServices.ComVisible(false)>]
 [<assembly: System.CLSCompliant(true)>]
@@ -102,9 +103,25 @@ module internal Utilities =
             member _.FsiAnyToLayout(options, o: obj, ty: Type) =
                 Display.fsi_any_to_layout options ((Unchecked.unbox o: 'T), ty)
 
-    let getAnyToLayoutCall ty =
-        let specialized = typedefof<AnyToLayoutSpecialization<_>>.MakeGenericType [| ty |]
-        Activator.CreateInstance(specialized) :?> IAnyToLayoutCall
+    let getAnyToLayoutCall (ty: Type) =
+        if ty.IsPointer then
+            let pointerToNativeInt (o: obj) : nativeint =
+                System.Reflection.Pointer.Unbox o
+                |> NativeInterop.NativePtr.ofVoidPtr<nativeptr<byte>>
+                |> NativeInterop.NativePtr.toNativeInt
+
+            { new IAnyToLayoutCall with
+                member _.AnyToLayout(options, o: obj, ty: Type) =
+                    let n = pointerToNativeInt o
+                    Display.any_to_layout options (n, n.GetType())
+
+                member _.FsiAnyToLayout(options, o: obj, ty: Type) =
+                    let n = pointerToNativeInt o
+                    Display.any_to_layout options (n, n.GetType())
+            }
+        else
+            let specialized = typedefof<AnyToLayoutSpecialization<_>>.MakeGenericType [| ty |]
+            Activator.CreateInstance(specialized) :?> IAnyToLayoutCall
 
     let callStaticMethod (ty: Type) name args =
         ty.InvokeMember(
diff --git a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs
index cfc86ff361..93f9da6c30 100644
--- a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs
+++ b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs
@@ -15,6 +15,13 @@ module ``Interactive tests`` =
         |> withEvalTypeEquals typeof<int>
         |> withEvalValueEquals 2
 
+    [<Fact>]
+    let ``Pretty print void pointer``() =
+        Fsx "System.IntPtr.Zero.ToPointer()"
+        |> runFsi
+        |> shouldSucceed
+        |> withStdOutContains "val it: voidptr = 0n"
+
     [<Fact>]
     let ``EntryPoint attribute in FSI should produce a compiler warning`` () =
         Fsx "[<EntryPoint>] let myFunc _ = 0"
diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs
index 7045cf0c4b..f9f2debeaa 100644
--- a/tests/FSharp.Test.Utilities/Compiler.fs
+++ b/tests/FSharp.Test.Utilities/Compiler.fs
@@ -962,15 +962,18 @@ module rec Compiler =
                                     opts.Add($"-I:\"{(outputDirectory.Value.FullName)}\"")
                         | _ -> ()
                     opts.ToArray()
-                let errors = CompilerAssert.RunScriptWithOptionsAndReturnResult options source
+                let errors, stdOut = CompilerAssert.RunScriptWithOptionsAndReturnResult options source
 
+                let executionOutputwithStdOut: RunOutput option =
+                    ExecutionOutput { StdOut = stdOut; ExitCode = 0; StdErr = "" }
+                    |> Some
                 let result =
                     { OutputPath   = None
                       Dependencies = []
                       Adjust       = 0
                       Diagnostics  = []
                       PerFileErrors= []
-                      Output       = None
+                      Output       = executionOutputwithStdOut
                       Compilation  = cUnit }
 
                 if errors.Count > 0 then
diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs
index d018461571..c5ec19006e 100644
--- a/tests/FSharp.Test.Utilities/CompilerAssert.fs
+++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs
@@ -940,10 +940,10 @@ Updated automatically, please check diffs in your pull request, changes must be
         | Choice2Of2 ex -> errorMessages.Add(ex.Message)
         | _ -> ()
 
-        errorMessages
+        errorMessages, outStream.ToString()
 
     static member RunScriptWithOptions options (source: string) (expectedErrorMessages: string list) =
-        let errorMessages = CompilerAssert.RunScriptWithOptionsAndReturnResult options source
+        let errorMessages, _ = CompilerAssert.RunScriptWithOptionsAndReturnResult options source
         if expectedErrorMessages.Length <> errorMessages.Count then
             Assert.Fail(sprintf "Expected error messages: %A \n\n Actual error messages: %A" expectedErrorMessages errorMessages)
         else