[VisualBasic] Fix TypeName for COM objects (#40584)

* Initial try of TypeName for ComObjects on Windows

* Implemented TypeNameOfCOMObject to use in Versioned.TypeName

* Separated tests of the TypeName for COM objects

* Utils.VBFriendlyName now matches reference source

* Moved TypeName for COM objects tests to VersionedTests

* Added ILLinkTrim.xml as a temporary solution as comented on #35937

* UnsafeNativeMethods are only available on Windows

* Test refactoration

* Skip COM interop test on Mono

* Explicit types in ILLinkTrim.xml

* Call GetTypeFromProgID with throwOnError true

* Disabled TypeName_ComObject test on Windows Nano

diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml b/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml
new file mode 100644 (file)
index 0000000..0b03152
--- /dev/null
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml
@@ -0,0 +1,8 @@
+<linker>
+  <assembly fullname="Microsoft.VisualBasic.Core">
+    <!-- Workaround for https://github.com/mono/linker/issues/378 -->
+    <type fullname="Microsoft.VisualBasic.CompilerServices.UnsafeNativeMethods/IDispatch"/>
+    <type fullname="Microsoft.VisualBasic.CompilerServices.UnsafeNativeMethods/IProvideClassInfo"/>
+    <type fullname="Microsoft.VisualBasic.CompilerServices.UnsafeNativeMethods/ITypeInfo"/>
+  </assembly>
+</linker>

diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
index 60b60d5..d2c9722 100644 (file)
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Utils.LateBinder.vb
@@ -343,6 +343,10 @@ GetSpecialValue:
         End Function
 
         Friend Shared Function VBFriendlyName(ByVal typ As System.Type, ByVal o As Object) As String
+            If typ.IsCOMObject AndAlso (typ.FullName = "System.__ComObject") Then
+                Return TypeNameOfCOMObject(o, False)
+            End If
+
             Return VBFriendlyNameOfType(typ)
         End Function
 

diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
index 3d54d11..ec2405e 100644 (file)
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/Versioned.vb
@@ -110,7 +110,15 @@ Namespace Microsoft.VisualBasic.CompilerServices
             End If
 
             typ = Expression.GetType()
+#If TARGET_WINDOWS Then
+            If (typ.IsCOMObject AndAlso (System.String.CompareOrdinal(typ.Name, COMObjectName) = 0)) Then
+                Result = TypeNameOfCOMObject(Expression, True)
+            Else
+                Result = VBFriendlyNameOfType(typ)
+            End If
+#Else
             Result = VBFriendlyNameOfType(typ)
+#End If
             Return Result
         End Function
 

diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
index 551571b..e021b54 100644 (file)
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Helpers/UnsafeNativeMethods.vb
@@ -60,6 +60,249 @@ Namespace Microsoft.VisualBasic.CompilerServices
         Friend Shared Function GetLogicalDrives() As Integer
         End Function
 
+        Public Const LCID_US_ENGLISH As Integer = &H409
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)>
+        Public Enum tagSYSKIND
+            SYS_WIN16 = 0
+            SYS_MAC = 2
+        End Enum
+
+        ' REVIEW :  - c# version was class, does it make a difference?
+        '    [StructLayout(LayoutKind.Sequential)]
+        '    Public class  tagTLIBATTR {
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)>
+        Public Structure tagTLIBATTR
+            Public guid As Guid
+            Public lcid As Integer
+            Public syskind As tagSYSKIND
+            <MarshalAs(UnmanagedType.U2)> Public wMajorVerNum As Short
+            <MarshalAs(UnmanagedType.U2)> Public wMinorVerNum As Short
+            <MarshalAs(UnmanagedType.U2)> Public wLibFlags As Short
+        End Structure
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never),
+         ComImport(),
+         Guid("00020403-0000-0000-C000-000000000046"),
+         InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)>
+        Public Interface ITypeComp
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteBind(
+                   <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szName As String,
+                   <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+                   <[In](), MarshalAs(UnmanagedType.U2)> ByVal wFlags As Short,
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTInfo As ITypeInfo(),
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pDescKind As ComTypes.DESCKIND(),
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppFuncDesc As ComTypes.FUNCDESC(),
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppVarDesc As ComTypes.VARDESC(),
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTypeComp As ITypeComp(),
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pDummy As Integer())
+
+            Sub RemoteBindType(
+                   <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szName As String,
+                   <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+                   <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTInfo As ITypeInfo())
+        End Interface
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never),
+         ComImport(),
+         Guid("00020400-0000-0000-C000-000000000046"),
+         InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)>
+        Public Interface IDispatch
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function GetTypeInfoCount() As Integer
+
+            <PreserveSig()>
+            Function GetTypeInfo(
+                    <[In]()> ByVal index As Integer,
+                    <[In]()> ByVal lcid As Integer,
+                    <[Out](), MarshalAs(UnmanagedType.Interface)> ByRef pTypeInfo As ITypeInfo) As Integer
+
+            ' WARNING :  - This api NOT COMPLETELY DEFINED, DO NOT CALL!
+            <PreserveSig()>
+            Function GetIDsOfNames() As Integer
+
+            ' WARNING :  - This api NOT COMPLETELY DEFINED, DO NOT CALL!
+            <PreserveSig()>
+            Function Invoke() As Integer
+        End Interface
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never),
+         ComImport(),
+         Guid("00020401-0000-0000-C000-000000000046"),
+         InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)>
+        Public Interface ITypeInfo
+            <PreserveSig()>
+            Function GetTypeAttr(
+                    <Out()> ByRef pTypeAttr As IntPtr) As Integer
+
+            <PreserveSig()>
+            Function GetTypeComp(
+                    <Out()> ByRef pTComp As ITypeComp) As Integer
+
+
+            <PreserveSig()>
+            Function GetFuncDesc(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out()> ByRef pFuncDesc As IntPtr) As Integer
+
+            <PreserveSig()>
+            Function GetVarDesc(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out()> ByRef pVarDesc As IntPtr) As Integer
+
+            <PreserveSig()>
+            Function GetNames(
+                    <[In]()> ByVal memid As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal rgBstrNames As String(),
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal cMaxNames As Integer,
+                    <Out(), MarshalAs(UnmanagedType.U4)> ByRef cNames As Integer) As Integer
+
+            <Obsolete("Bad signature, second param type should be Byref. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function GetRefTypeOfImplType(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out()> ByRef pRefType As Integer) As Integer
+
+            <Obsolete("Bad signature, second param type should be Byref. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function GetImplTypeFlags(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out()> ByVal pImplTypeFlags As Integer) As Integer
+
+            <PreserveSig()>
+            Function GetIDsOfNames(
+                    <[In]()> ByVal rgszNames As IntPtr,
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal cNames As Integer,
+                    <Out()> ByRef pMemId As IntPtr) As Integer
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function Invoke() As Integer
+
+            <PreserveSig()>
+            Function GetDocumentation(
+                     <[In]()> ByVal memid As Integer,
+                     <Out(), MarshalAs(UnmanagedType.BStr)> ByRef pBstrName As String,
+                     <Out(), MarshalAs(UnmanagedType.BStr)> ByRef pBstrDocString As String,
+                     <Out(), MarshalAs(UnmanagedType.U4)> ByRef pdwHelpContext As Integer,
+                     <Out(), MarshalAs(UnmanagedType.BStr)> ByRef pBstrHelpFile As String) As Integer
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function GetDllEntry(
+                    <[In]()> ByVal memid As Integer,
+                    <[In]()> ByVal invkind As ComTypes.INVOKEKIND,
+                    <Out(), MarshalAs(UnmanagedType.BStr)> ByVal pBstrDllName As String,
+                    <Out(), MarshalAs(UnmanagedType.BStr)> ByVal pBstrName As String,
+                    <Out(), MarshalAs(UnmanagedType.U2)> ByVal pwOrdinal As Short) As Integer
+
+            <PreserveSig()>
+            Function GetRefTypeInfo(
+                     <[In]()> ByVal hreftype As IntPtr,
+                     <Out()> ByRef pTypeInfo As ITypeInfo) As Integer
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function AddressOfMember() As Integer
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function CreateInstance(
+                    <[In]()> ByRef pUnkOuter As IntPtr,
+                    <[In]()> ByRef riid As Guid,
+                    <Out(), MarshalAs(UnmanagedType.IUnknown)> ByVal ppvObj As Object) As Integer
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            <PreserveSig()>
+            Function GetMops(
+                    <[In]()> ByVal memid As Integer,
+                    <Out(), MarshalAs(UnmanagedType.BStr)> ByVal pBstrMops As String) As Integer
+
+            <PreserveSig()>
+            Function GetContainingTypeLib(
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTLib As ITypeLib(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pIndex As Integer()) As Integer
+
+            <PreserveSig()>
+            Sub ReleaseTypeAttr(ByVal typeAttr As IntPtr)
+
+            <PreserveSig()>
+            Sub ReleaseFuncDesc(ByVal funcDesc As IntPtr)
+
+            <PreserveSig()>
+            Sub ReleaseVarDesc(ByVal varDesc As IntPtr)
+        End Interface
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never),
+         ComImport(),
+         Guid("B196B283-BAB4-101A-B69C-00AA00341D07"),
+         InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)>
+        Public Interface IProvideClassInfo
+            Function GetClassInfo() As <MarshalAs(UnmanagedType.Interface)> ITypeInfo
+        End Interface
+
+        <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never),
+         ComImport(),
+         Guid("00020402-0000-0000-C000-000000000046"),
+         InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)>
+        Public Interface ITypeLib
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteGetTypeInfoCount(
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pcTInfo As Integer())
+
+            Sub GetTypeInfo(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTInfo As ITypeInfo())
+
+            Sub GetTypeInfoType(
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pTKind As ComTypes.TYPEKIND())
+
+            Sub GetTypeInfoOfGuid(
+                    <[In]()> ByRef guid As Guid,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTInfo As ITypeInfo())
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteGetLibAttr(
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTLibAttr As tagTLIBATTR(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pDummy As Integer())
+
+            Sub GetTypeComp(
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTComp As ITypeComp())
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteGetDocumentation(
+            ByVal index As Integer,
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal refPtrFlags As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pBstrName As String(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pBstrDocString As String(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pdwHelpContext As Integer(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pBstrHelpFile As String())
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteIsName(
+                    <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String,
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pfName As IntPtr(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pBstrLibName As String())
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub RemoteFindName(
+                    <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String,
+                    <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer,
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal ppTInfo As ITypeInfo(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal rgMemId As Integer(),
+                    <[In](), Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pcFound As Short(),
+                    <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pBstrLibName As String())
+
+            <Obsolete("Bad signature. Fix and verify signature before use.", True)>
+            Sub LocalReleaseTLibAttr()
+        End Interface
+
         ''' <summary>
         ''' Frees memory allocated from the local heap. i.e. frees memory allocated
         ''' by LocalAlloc or LocalReAlloc.n

diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
index ad35199..4c85fc2 100644 (file)
--- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
+++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb
@@ -156,6 +156,64 @@ Namespace Microsoft.VisualBasic
 
         End Function
 
+        Friend Function TypeNameOfCOMObject(ByVal VarName As Object, ByVal bThrowException As Boolean) As String
+
+            Dim Result As String = COMObjectName
+
+#If TARGET_WINDOWS Then
+            Dim pTypeInfo As UnsafeNativeMethods.ITypeInfo = Nothing
+            Dim hr As Integer
+            Dim ClassName As String = Nothing
+            Dim DocString As String = Nothing
+            Dim HelpContext As Integer
+            Dim HelpFile As String = Nothing
+
+
+            Do
+                Dim pProvideClassInfo As UnsafeNativeMethods.IProvideClassInfo = TryCast(VarName, UnsafeNativeMethods.IProvideClassInfo)
+
+                If pProvideClassInfo IsNot Nothing Then
+                    Try
+                        pTypeInfo = pProvideClassInfo.GetClassInfo()
+                        hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+                        If hr >= 0 Then
+                            Result = ClassName
+                            Exit Do
+                        End If
+                        pTypeInfo = Nothing
+                    Catch ex As StackOverflowException
+                        Throw ex
+                    Catch ex As OutOfMemoryException
+                        Throw ex
+                    Catch
+                        'Ignore the error
+                    End Try
+                End If
+
+                Dim pDispatch As UnsafeNativeMethods.IDispatch = TryCast(VarName, UnsafeNativeMethods.IDispatch)
+
+                If pDispatch IsNot Nothing Then
+                    ' Try using IDispatch 
+                    hr = pDispatch.GetTypeInfo(0, UnsafeNativeMethods.LCID_US_ENGLISH, pTypeInfo)
+                    If hr >= 0 Then
+                        hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+                        If hr >= 0 Then
+                            Result = ClassName
+                            Exit Do
+                        End If
+                    End If
+                End If
+
+            Loop While (False)
+#End If
+
+
+            If Result.Chars(0) = "_"c Then
+                Result = Result.Substring(1)
+            End If
+
+            Return Result
+        End Function
 
         Public Function QBColor(ByVal Color As Integer) As Integer
             If (Color And &HFFF0I) <> 0 Then
@@ -498,6 +556,27 @@ UnmangleName:
 
             Dim Result As String = COMObjectName
 
+#If TARGET_WINDOWS Then
+            Dim pTypeInfo As UnsafeNativeMethods.ITypeInfo = Nothing
+            Dim hr As Integer
+            Dim ClassName As String = Nothing
+            Dim DocString As String = Nothing
+            Dim HelpContext As Integer
+            Dim HelpFile As String = Nothing
+
+            Dim pDispatch As UnsafeNativeMethods.IDispatch = TryCast(VarName, UnsafeNativeMethods.IDispatch)
+
+            If pDispatch IsNot Nothing Then
+                hr = pDispatch.GetTypeInfo(0, UnsafeNativeMethods.LCID_US_ENGLISH, pTypeInfo)
+                If hr >= 0 Then
+                    hr = pTypeInfo.GetDocumentation(-1, ClassName, DocString, HelpContext, HelpFile)
+                    If hr >= 0 Then
+                        Result = ClassName
+                    End If
+                End If
+            End If
+#End If
+
             If Result.Chars(0) = "_"c Then
                 Result = Result.Substring(1)
             End If

diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs b/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
index 56b8591..c2a930c 100644 (file)
--- a/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
+++ b/src/libraries/Microsoft.VisualBasic.Core/tests/CompilerServices/VersionedTests.cs
@@ -106,6 +106,16 @@ namespace Microsoft.VisualBasic.Tests
             Assert.Equal(expected, Versioned.TypeName(expression));
         }
 
+        [ConditionalTheory(typeof(PlatformDetection), nameof(PlatformDetection.IsWindows), nameof(PlatformDetection.IsNotWindowsNanoServer))]
+        [MemberData(nameof(TypeName_ComObject_TestData))]
+        [SkipOnMono("COM Interop not supported on Mono")]
+        public void TypeName_ComObject(string progId, string expected)
+        {
+            Type type = Type.GetTypeFromProgID(progId, true);
+            object expression = Activator.CreateInstance(type);
+            Assert.Equal(expected, Versioned.TypeName(expression));
+        }
+
         public static IEnumerable<object[]> TypeName_TestData()
         {
             yield return new object[] { null, "Nothing" };
@@ -132,6 +142,13 @@ namespace Microsoft.VisualBasic.Tests
             yield return new object[] { (int?)0, "Integer" };
         }
 
+        public static IEnumerable<object[]> TypeName_ComObject_TestData()
+        {
+            yield return new object[] { "ADODB.Stream", "Stream" };
+            yield return new object[] { "MSXML2.DOMDocument", "DOMDocument" };
+            yield return new object[] { "Scripting.Dictionary", "Dictionary" };
+        }
+
         [Theory]
         [InlineData(null, null)]
         [InlineData("System.Object", "Object")]