File: Microsoft\VisualBasic\CompilerServices\Utils.vb
Web Access
Project: src\src\libraries\Microsoft.VisualBasic.Core\src\Microsoft.VisualBasic.Core.vbproj (Microsoft.VisualBasic.Core)
' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
 
Imports System
Imports System.Diagnostics
Imports System.Globalization
Imports System.Linq
Imports System.Linq.Expressions
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Security
Imports System.Text
 
Namespace Global.Microsoft.VisualBasic.CompilerServices
    <Global.System.Diagnostics.DebuggerNonUserCode()>
    <Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)>
    Partial Public Class Utils
        Private Sub New()
        End Sub
 
        <Diagnostics.DebuggerHiddenAttribute()>
        Friend Shared Sub SetTime(ByVal dtTime As DateTime)
#If TARGET_WINDOWS Then
            Dim systime As New NativeTypes.SystemTime
 
            SafeNativeMethods.GetLocalTime(systime)
 
            systime.wHour = CShort(dtTime.Hour)
            systime.wMinute = CShort(dtTime.Minute)
            systime.wSecond = CShort(dtTime.Second)
            systime.wMilliseconds = CShort(dtTime.Millisecond)
 
            If UnsafeNativeMethods.SetLocalTime(systime) = 0 Then
                If Marshal.GetLastWin32Error() = ERROR_INVALID_PARAMETER Then
                    Throw New ArgumentException(SR.Argument_InvalidValue)
                Else
                    Throw New SecurityException(SR.SetLocalTimeFailure)
                End If
            End If
#Else
            Throw New PlatformNotSupportedException()
#End If
        End Sub
 
        <Diagnostics.DebuggerHiddenAttribute()>
        Friend Shared Sub SetDate(ByVal vDate As DateTime)
#If TARGET_WINDOWS Then
            Dim systime As New NativeTypes.SystemTime
 
            SafeNativeMethods.GetLocalTime(systime)
 
            systime.wYear = CShort(vDate.Year)
            systime.wMonth = CShort(vDate.Month)
            systime.wDay = CShort(vDate.Day)
 
            If UnsafeNativeMethods.SetLocalTime(systime) = 0 Then
                If Marshal.GetLastWin32Error() = ERROR_INVALID_PARAMETER Then
                    Throw New ArgumentException(SR.Argument_InvalidValue)
                Else
                    Throw New SecurityException(SR.SetLocalDateFailure)
                End If
            End If
#Else
            Throw New PlatformNotSupportedException()
#End If
        End Sub
 
        Friend Shared Function GetDateTimeFormatInfo() As DateTimeFormatInfo
            Return System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat
        End Function
 
        Friend Shared Function GetFileIOEncoding() As Encoding
            Return System.Text.Encoding.Default
        End Function
 
        Friend Shared Function GetLocaleCodePage() As Integer
            Return System.Threading.Thread.CurrentThread.CurrentCulture.TextInfo.ANSICodePage
        End Function
 
        Public Shared Function CopyArray(arySrc As Global.System.Array, aryDest As Global.System.Array) As Global.System.Array
            If arySrc Is Nothing Then
                Return aryDest
            End If
            Dim lLength As Integer
            lLength = arySrc.Length
            If lLength = 0 Then
                Return aryDest
            End If
            If aryDest.Rank() <> arySrc.Rank() Then
                Throw New Global.System.InvalidCastException()
            End If
            Dim iDim As Integer
            For iDim = 0 To aryDest.Rank() - 2
                If aryDest.GetUpperBound(iDim) <> arySrc.GetUpperBound(iDim) Then
                    Throw New Global.System.ArrayTypeMismatchException()
                End If
            Next iDim
            If lLength > aryDest.Length Then
                lLength = aryDest.Length
            End If
            If arySrc.Rank > 1 Then
                Dim lastRank As Integer = arySrc.Rank
                Dim lenSrcLastRank As Integer = arySrc.GetLength(lastRank - 1)
                Dim lenDestLastRank As Integer = aryDest.GetLength(lastRank - 1)
                If lenDestLastRank = 0 Then
                    Return aryDest
                End If
                Dim lenCopy As Integer = If(lenSrcLastRank > lenDestLastRank, lenDestLastRank, lenSrcLastRank)
                Dim i As Integer
                For i = 0 To (arySrc.Length \ lenSrcLastRank) - 1
                    Global.System.Array.Copy(arySrc, i * lenSrcLastRank, aryDest, i * lenDestLastRank, lenCopy)
                Next i
            Else
                Global.System.Array.Copy(arySrc, aryDest, lLength)
            End If
            Return aryDest
        End Function
 
    End Class
 
    Friend Module ReflectionExtensions
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Public Function GetTypeCode(type As Type) As TypeCode
            Return Type.GetTypeCode(type)
        End Function
 
        Public ReadOnly Property BindingFlagsInvokeMethod As BindingFlags
            Get
                Return CType(256, BindingFlags) ' BindingFlags.InvokeMethod
            End Get
        End Property
 
        Public ReadOnly Property BindingFlagsGetProperty As BindingFlags
            Get
                Return CType(4096, BindingFlags) ' BindingFlags.GetProperty
            End Get
        End Property
 
        Public ReadOnly Property BindingFlagsSetProperty As BindingFlags
            Get
                Return CType(8192, BindingFlags) ' BindingFlags.SetProperty
            End Get
        End Property
 
        Public ReadOnly Property BindingFlagsIgnoreReturn As BindingFlags
            Get
                Return CType(16777216, BindingFlags) ' BindingFlags.IgnoreReturn
            End Get
        End Property
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Public Function IsEquivalentTo(mi1 As MethodBase, mi2 As MethodBase) As Boolean
 
            If mi1 Is Nothing OrElse mi2 Is Nothing Then
                Return mi1 Is Nothing AndAlso mi2 Is Nothing
            End If
 
            If mi1.Equals(mi2) Then
                Return True
            End If
 
            If TypeOf mi1 Is MethodInfo AndAlso TypeOf mi2 Is MethodInfo Then
                Dim method1 As MethodInfo = DirectCast(mi1, MethodInfo)
                Dim method2 As MethodInfo = DirectCast(mi2, MethodInfo)
 
                If method1.IsGenericMethod <> method2.IsGenericMethod Then
                    Return False
                End If
 
                If method1.IsGenericMethod Then
                    method1 = method1.GetGenericMethodDefinition()
                    method2 = method2.GetGenericMethodDefinition()
 
                    If method1.GetGenericArguments().Length <> method2.GetGenericArguments().Length Then
                        Return False ' Methods of different arity are not equivalent.
                    End If
                End If
 
                If Not method1.Equals(method2) AndAlso
                   method1.Name.Equals(method2.Name) AndAlso
                   method1.DeclaringType.IsGenericallyEqual(method2.DeclaringType) AndAlso
                   method1.ReturnType.IsGenericallyEquivalentTo(method2.ReturnType, method1, method2) Then
 
                    Dim pis1 As ParameterInfo() = method1.GetParameters()
                    Dim pis2 As ParameterInfo() = method2.GetParameters()
 
                    Return pis1.Length = pis2.Length AndAlso
                           Enumerable.All(Enumerable.Zip(pis1,
                                                         pis2,
                                                         Function(pi1, pi2) pi1.IsEquivalentTo(pi2, method1, method2)),
                                                     Function(x) x)
                End If
 
                Return False
            End If
 
            If TypeOf mi1 Is ConstructorInfo AndAlso TypeOf mi2 Is ConstructorInfo Then
                Dim ctor1 As ConstructorInfo = DirectCast(mi1, ConstructorInfo)
                Dim ctor2 As ConstructorInfo = DirectCast(mi2, ConstructorInfo)
 
                If Not ctor1.Equals(ctor2) AndAlso
                   ctor1.DeclaringType.IsGenericallyEqual(ctor2.DeclaringType) Then
 
                    Dim pis1 As ParameterInfo() = ctor1.GetParameters()
                    Dim pis2 As ParameterInfo() = ctor2.GetParameters()
 
                    Return pis1.Length = pis2.Length AndAlso
                           Enumerable.All(Enumerable.Zip(pis1,
                                                         pis2,
                                                         Function(pi1, pi2) pi1.IsEquivalentTo(pi2, ctor1, ctor2)),
                                                     Function(x) x)
                End If
 
                Return False
            End If
 
            Return False
        End Function
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Private Function IsEquivalentTo(pi1 As ParameterInfo, pi2 As ParameterInfo, method1 As MethodBase, method2 As MethodBase) As Boolean
 
            If pi1 Is Nothing OrElse pi2 Is Nothing Then
                Return pi1 Is Nothing AndAlso pi2 Is Nothing
            End If
 
            If pi1.Equals(pi2) Then
                Return True
            End If
 
            Return pi1.ParameterType.IsGenericallyEquivalentTo(pi2.ParameterType, method1, method2)
        End Function
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Private Function IsGenericallyEqual(t1 As Type, t2 As Type) As Boolean
 
            If t1 Is Nothing OrElse t2 Is Nothing Then
                Return t1 Is Nothing AndAlso t2 Is Nothing
            End If
 
            If t1.Equals(t2) Then
                Return True
            End If
 
            If t1.IsConstructedGenericType OrElse t2.IsConstructedGenericType Then
                Dim t1def As Type = If(t1.IsConstructedGenericType, t1.GetGenericTypeDefinition(), t1)
                Dim t2def As Type = If(t2.IsConstructedGenericType, t2.GetGenericTypeDefinition(), t2)
 
                Return t1def.Equals(t2def)
            End If
 
            Return False
        End Function
 
        ' Compares two types and calls them equivalent if a type parameter equals a type argument.
        ' i.e if the inputs are (T, int, C(Of T), C(Of Integer)) then this will return true.
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Private Function IsGenericallyEquivalentTo(t1 As Type, t2 As Type, member1 As MemberInfo, member2 As MemberInfo) As Boolean
 
            Debug.Assert(Not (TypeOf member1 Is MethodBase) OrElse
                         Not DirectCast(member1, MethodBase).IsGenericMethod OrElse
                         (DirectCast(member1, MethodBase).IsGenericMethodDefinition AndAlso DirectCast(member2, MethodBase).IsGenericMethodDefinition))
 
            If t1.Equals(t2) Then
                Return True
            End If
 
            ' If one of them is a type param and then the other is a real type, then get the type argument in the member
            ' or it's declaring type that corresponds to the type param and compare that to the other type.
            If t1.IsGenericParameter Then
                If t2.IsGenericParameter Then
                    ' If member's declaring type is not type parameter's declaring type, we assume that it is used as a type argument
                    If t1.DeclaringMethod Is Nothing AndAlso member1.DeclaringType.Equals(t1.DeclaringType) Then
                        If Not (t2.DeclaringMethod Is Nothing AndAlso member2.DeclaringType.Equals(t2.DeclaringType)) Then
                            Return t1.IsTypeParameterEquivalentToTypeInst(t2, member2)
                        End If
                    ElseIf t2.DeclaringMethod Is Nothing AndAlso member2.DeclaringType.Equals(t2.DeclaringType) Then
                        Return t2.IsTypeParameterEquivalentToTypeInst(t1, member1)
                    End If
 
                    ' If both of these are type params but didn't compare to be equal then one of them is likely bound to another
                    ' open type. Simply disallow such cases.
                    Return False
                End If
 
                Return t1.IsTypeParameterEquivalentToTypeInst(t2, member2)
 
            ElseIf t2.IsGenericParameter Then
                Return t2.IsTypeParameterEquivalentToTypeInst(t1, member1)
            End If
 
            ' Recurse in for generic types arrays, byref and pointer types.
            If t1.IsGenericType AndAlso t2.IsGenericType Then
                Dim args1 As Type() = t1.GetGenericArguments()
                Dim args2 As Type() = t2.GetGenericArguments()
 
                If args1.Length = args2.Length Then
                    Return t1.IsGenericallyEqual(t2) AndAlso
                           Enumerable.All(Enumerable.Zip(args1,
                                                         args2,
                                                         Function(ta1, ta2) ta1.IsGenericallyEquivalentTo(ta2, member1, member2)),
                                                     Function(x) x)
                End If
            End If
 
            If t1.IsArray AndAlso t2.IsArray Then
                Return t1.GetArrayRank() = t2.GetArrayRank() AndAlso
                       t1.GetElementType().IsGenericallyEquivalentTo(t2.GetElementType(), member1, member2)
            End If
 
            If (t1.IsByRef AndAlso t2.IsByRef) OrElse
               (t1.IsPointer AndAlso t2.IsPointer) Then
                Return t1.GetElementType().IsGenericallyEquivalentTo(t2.GetElementType(), member1, member2)
            End If
 
            Return False
        End Function
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Private Function IsTypeParameterEquivalentToTypeInst(typeParam As Type, typeInst As Type, member As MemberInfo) As Boolean
 
            Debug.Assert(typeParam.IsGenericParameter)
 
            If typeParam.DeclaringMethod IsNot Nothing Then
                ' The type param is from a generic method. Since only methods can be generic, anything else
                ' here means they are not equivalent.
                If Not (TypeOf member Is MethodBase) Then
                    Return False
                End If
 
                Dim method As MethodBase = DirectCast(member, MethodBase)
                Dim position As Integer = typeParam.GenericParameterPosition
                Dim args As Type() = If(method.IsGenericMethod, method.GetGenericArguments(), Nothing)
 
                Return args IsNot Nothing AndAlso
                       args.Length > position AndAlso
                       args(position).Equals(typeInst)
            Else
                Return member.DeclaringType.GetGenericArguments()(typeParam.GenericParameterPosition).Equals(typeInst)
            End If
        End Function
 
        ' s_MemberEquivalence will replace itself with one version or another
        ' depending on what works at run time
        Private s_MemberEquivalence As Func(Of MethodBase, MethodBase, Boolean) =
            Function(m1, m2)
                Try
                    ' See if MetadataToken property is available.
                    Dim MemberInfo As Type = GetType(MethodBase)
                    Dim [property] As PropertyInfo = MemberInfo.GetProperty("MetadataToken", GetType(Integer), Array.Empty(Of Type)())
 
                    If ([property] IsNot Nothing AndAlso [property].CanRead) Then
                        ' Function(parameter1, parameter2) parameter1.MetadataToken = parameter2.MetadataToken
                        Dim parameter1 As ParameterExpression = Expression.Parameter(MemberInfo)
                        Dim parameter2 As ParameterExpression = Expression.Parameter(MemberInfo)
                        Dim memberEquivalence As Func(Of MethodBase, MethodBase, Boolean) = Expression.Lambda(Of Func(Of MethodBase, MethodBase, Boolean))(
                                            Expression.Equal(
                                                Expression.Property(parameter1, [property]),
                                                Expression.Property(parameter2, [property])),
                                                {parameter1, parameter2}).Compile()
 
                        Dim result As Boolean = memberEquivalence(m1, m2)
                        ' it worked, so publish it
                        s_MemberEquivalence = memberEquivalence
 
                        Return result
                    End If
                Catch
                    ' Platform might not allow access to the property
                End Try
 
                ' MetadataToken is not available in some contexts. Looks like this is one of those cases.
                ' fallback to "IsEquivalentTo"
                Dim fallbackMemberEquivalence As Func(Of MethodBase, MethodBase, Boolean) = Function(m1param, m2param) m1param.IsEquivalentTo(m2param)
 
                ' fallback must work
                s_MemberEquivalence = fallbackMemberEquivalence
                Return fallbackMemberEquivalence(m1, m2)
            End Function
 
 
        <System.Runtime.CompilerServices.ExtensionAttribute()>
        Public Function HasSameMetadataDefinitionAs(mi1 As MethodBase, mi2 As MethodBase) As Boolean
            Return mi1.Module.Equals(mi2.Module) AndAlso s_MemberEquivalence(mi1, mi2)
        End Function
 
    End Module
End Namespace