From: Edison Henrique Andreassy Date: Tue, 11 Aug 2020 23:34:01 +0000 (-0300) Subject: [VisualBasic] Fix TypeName for COM objects (#40584) X-Git-Tag: submit/tizen/20210909.063632~6065 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=8bc5dbd1e5b9fb38bd0b5f3e53409865f93bda3d;p=platform%2Fupstream%2Fdotnet%2Fruntime.git [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 index 0000000..0b03152 --- /dev/null +++ b/src/libraries/Microsoft.VisualBasic.Core/src/ILLinkTrim.xml @@ -0,0 +1,8 @@ + + + + + + + + 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 --- 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 --- 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 --- 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 + + + 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 { + + Public Structure tagTLIBATTR + Public guid As Guid + Public lcid As Integer + Public syskind As tagSYSKIND + Public wMajorVerNum As Short + Public wMinorVerNum As Short + Public wLibFlags As Short + End Structure + + + Public Interface ITypeComp + + + 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, + ByVal ppTInfo As ITypeInfo(), + ByVal pDescKind As ComTypes.DESCKIND(), + ByVal ppFuncDesc As ComTypes.FUNCDESC(), + ByVal ppVarDesc As ComTypes.VARDESC(), + ByVal ppTypeComp As ITypeComp(), + ByVal pDummy As Integer()) + + Sub RemoteBindType( + <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szName As String, + <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer, + ByVal ppTInfo As ITypeInfo()) + End Interface + + + Public Interface IDispatch + + + + Function GetTypeInfoCount() As Integer + + + 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! + + Function GetIDsOfNames() As Integer + + ' WARNING : - This api NOT COMPLETELY DEFINED, DO NOT CALL! + + Function Invoke() As Integer + End Interface + + + Public Interface ITypeInfo + + Function GetTypeAttr( + ByRef pTypeAttr As IntPtr) As Integer + + + Function GetTypeComp( + ByRef pTComp As ITypeComp) As Integer + + + + Function GetFuncDesc( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByRef pFuncDesc As IntPtr) As Integer + + + Function GetVarDesc( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByRef pVarDesc As IntPtr) As Integer + + + Function GetNames( + <[In]()> ByVal memid As Integer, + ByVal rgBstrNames As String(), + <[In](), MarshalAs(UnmanagedType.U4)> ByVal cMaxNames As Integer, + ByRef cNames As Integer) As Integer + + + + Function GetRefTypeOfImplType( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByRef pRefType As Integer) As Integer + + + + Function GetImplTypeFlags( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByVal pImplTypeFlags As Integer) As Integer + + + Function GetIDsOfNames( + <[In]()> ByVal rgszNames As IntPtr, + <[In](), MarshalAs(UnmanagedType.U4)> ByVal cNames As Integer, + ByRef pMemId As IntPtr) As Integer + + + + Function Invoke() As Integer + + + Function GetDocumentation( + <[In]()> ByVal memid As Integer, + ByRef pBstrName As String, + ByRef pBstrDocString As String, + ByRef pdwHelpContext As Integer, + ByRef pBstrHelpFile As String) As Integer + + + + Function GetDllEntry( + <[In]()> ByVal memid As Integer, + <[In]()> ByVal invkind As ComTypes.INVOKEKIND, + ByVal pBstrDllName As String, + ByVal pBstrName As String, + ByVal pwOrdinal As Short) As Integer + + + Function GetRefTypeInfo( + <[In]()> ByVal hreftype As IntPtr, + ByRef pTypeInfo As ITypeInfo) As Integer + + + + Function AddressOfMember() As Integer + + + + Function CreateInstance( + <[In]()> ByRef pUnkOuter As IntPtr, + <[In]()> ByRef riid As Guid, + ByVal ppvObj As Object) As Integer + + + + Function GetMops( + <[In]()> ByVal memid As Integer, + ByVal pBstrMops As String) As Integer + + + Function GetContainingTypeLib( + ByVal ppTLib As ITypeLib(), + ByVal pIndex As Integer()) As Integer + + + Sub ReleaseTypeAttr(ByVal typeAttr As IntPtr) + + + Sub ReleaseFuncDesc(ByVal funcDesc As IntPtr) + + + Sub ReleaseVarDesc(ByVal varDesc As IntPtr) + End Interface + + + Public Interface IProvideClassInfo + Function GetClassInfo() As ITypeInfo + End Interface + + + Public Interface ITypeLib + + Sub RemoteGetTypeInfoCount( + ByVal pcTInfo As Integer()) + + Sub GetTypeInfo( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByVal ppTInfo As ITypeInfo()) + + Sub GetTypeInfoType( + <[In](), MarshalAs(UnmanagedType.U4)> ByVal index As Integer, + ByVal pTKind As ComTypes.TYPEKIND()) + + Sub GetTypeInfoOfGuid( + <[In]()> ByRef guid As Guid, + ByVal ppTInfo As ITypeInfo()) + + + Sub RemoteGetLibAttr( + ByVal ppTLibAttr As tagTLIBATTR(), + ByVal pDummy As Integer()) + + Sub GetTypeComp( + ByVal ppTComp As ITypeComp()) + + + Sub RemoteGetDocumentation( + ByVal index As Integer, + <[In](), MarshalAs(UnmanagedType.U4)> ByVal refPtrFlags As Integer, + ByVal pBstrName As String(), + ByVal pBstrDocString As String(), + ByVal pdwHelpContext As Integer(), + ByVal pBstrHelpFile As String()) + + + Sub RemoteIsName( + <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String, + <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer, + ByVal pfName As IntPtr(), + ByVal pBstrLibName As String()) + + + Sub RemoteFindName( + <[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal szNameBuf As String, + <[In](), MarshalAs(UnmanagedType.U4)> ByVal lHashVal As Integer, + ByVal ppTInfo As ITypeInfo(), + ByVal rgMemId As Integer(), + <[In](), Out(), MarshalAs(UnmanagedType.LPArray)> ByVal pcFound As Short(), + ByVal pBstrLibName As String()) + + + Sub LocalReleaseTLibAttr() + End Interface + ''' ''' 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 --- 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 --- 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 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 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")]