' Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. Imports System.Collections.Immutable Imports System.Runtime.CompilerServices Imports Microsoft.CodeAnalysis.Text Imports Microsoft.CodeAnalysis.VisualBasic Imports Microsoft.CodeAnalysis.VisualBasic.Symbols Imports Microsoft.CodeAnalysis.VisualBasic.Syntax Imports Xunit Module Extensions Public Function GetReferencedAssemblySymbol(compilation As Compilation, reference As MetadataReference) As AssemblySymbol Return DirectCast(compilation.GetAssemblyOrModuleSymbol(reference), AssemblySymbol) End Function Public Function GetReferencedModuleSymbol(compilation As Compilation, reference As MetadataReference) As ModuleSymbol Return DirectCast(compilation.GetAssemblyOrModuleSymbol(reference), ModuleSymbol) End Function Public Function ToTestDisplayString(Symbol As ISymbol) As String Return Symbol.ToDisplayString(SymbolDisplayFormat.TestFormat) End Function Private Function SplitMemberName(qualifiedName As String) As ImmutableArray(Of String) Dim builder = ArrayBuilder(Of String).GetInstance() Dim curr = qualifiedName While curr.Length > 0 builder.Add(MetadataHelpers.SplitQualifiedName(curr, curr)) End While builder.ReverseContents() Return builder.ToImmutableAndFree() End Function Public Function GetMember(comp As Compilation, qualifiedName As String) As Symbol Return DirectCast(comp, VisualBasicCompilation).GlobalNamespace.GetMember(qualifiedName) End Function Public Function GetMember(Of T As Symbol)(comp As Compilation, qualifiedName As String) As T Return DirectCast(DirectCast(comp, VisualBasicCompilation).GlobalNamespace.GetMember(qualifiedName), T) End Function Public Function GetMembers(comp As Compilation, name As String) As ImmutableArray(Of Symbol) Return GetMembers(DirectCast(comp, VisualBasicCompilation).GlobalNamespace, name) End Function Private Function GetMembers([namespace] As NamespaceSymbol, qualifiedName As String) As ImmutableArray(Of Symbol) Dim parts = SplitMemberName(qualifiedName) Dim symbol As NamespaceOrTypeSymbol = [namespace] For i = 0 To parts.Length - 2 symbol = DirectCast(symbol.GetMember(parts(i)), NamespaceOrTypeSymbol) Next Return symbol.GetMembers(parts(parts.Length - 1)) End Function Public Function GetMember([namespace] As NamespaceSymbol, qualifiedName As String) As Symbol Return GetMembers([namespace], qualifiedName).Single() End Function Public Function GetMember(symbol As NamespaceOrTypeSymbol, name As String) As Symbol Return symbol.GetMembers(name).Single() End Function Public Function GetMember(Of T As Symbol)(symbol As NamespaceOrTypeSymbol, name As String) As T Return DirectCast(symbol.GetMember(name), T) End Function Friend Function GetTypeMember(this As NamespaceOrTypeSymbol, name As String) As NamedTypeSymbol Return this.GetTypeMembers(name).Single End Function Friend Function GetNamespace(this As NamespaceSymbol, name As String) As NamespaceSymbol Return DirectCast(this.GetMembers(name).Single(), NamespaceSymbol) End Function Friend Function GetFieldNames(this As ModuleSymbol, qualifiedTypeName As String) As String() Dim type = DirectCast(this.GlobalNamespace.GetMember(qualifiedName:=qualifiedTypeName), NamedTypeSymbol) Return type.GetMembers().OfType(Of FieldSymbol)().Select(Of String)(Function(f) f.Name).ToArray() End Function Friend Function GetFieldNamesAndTypes(this As ModuleSymbol, qualifiedTypeName As String) As String() Dim type = DirectCast(this.GlobalNamespace.GetMember(qualifiedName:=qualifiedTypeName), NamedTypeSymbol) Return type.GetMembers().OfType(Of FieldSymbol)().Select(Of String)(Function(f) f.Name + ": " + f.Type.ToDisplayString(SymbolDisplayFormat.TestFormat)).ToArray() End Function Friend Function GetAttribute(this As Symbol, c As NamedTypeSymbol) As VisualBasicAttributeData Return this.GetAttributes().Where(Function(a) a.AttributeClass = c).First() End Function Friend Function GetAttribute(this As Symbol, m As MethodSymbol) As VisualBasicAttributeData Return this.GetAttributes().Where(Function(a) a.AttributeConstructor = m).First() End Function Friend Function GetAttributes(this As Symbol, c As NamedTypeSymbol) As IEnumerable(Of VisualBasicAttributeData) Return this.GetAttributes().Where(Function(a) a.AttributeClass = c) End Function Friend Function GetAttributes(this As Symbol, m As MethodSymbol) As IEnumerable(Of VisualBasicAttributeData) Return this.GetAttributes().Where(Function(a) a.AttributeConstructor = m) End Function Friend Function GetAttributes(this As Symbol, namespaceName As String, typeName As String) As IEnumerable(Of VisualBasicAttributeData) Return this.GetAttributes().Where(Function(a) a.IsTargetAttribute(namespaceName, typeName)) End Function Friend Function GetAttributes(this As Symbol, description As AttributeDescription) As IEnumerable(Of VisualBasicAttributeData) Return this.GetAttributes().Where(Function(a) a.IsTargetAttribute(this, description)) End Function Friend Sub VerifyValue(Of T)(ByVal attr As VisualBasicAttributeData, ByVal i As Integer, ByVal kind As TypedConstantKind, ByVal v As T) Dim arg = attr.CommonConstructorArguments(i) Assert.Equal(kind, arg.Kind) Assert.True(IsEqual(Of T)(arg, v)) End Sub Friend Sub VerifyValue(Of T)(ByVal attr As VisualBasicAttributeData, ByVal i As Integer, ByVal name As String, ByVal kind As TypedConstantKind, ByVal v As T) Dim namedArg = attr.CommonNamedArguments(i) Assert.Equal(namedArg.Key, name) Dim arg = namedArg.Value Assert.Equal(arg.Kind, kind) Assert.True(IsEqual(Of T)(arg, v)) End Sub Friend Sub VerifyNamedArgumentValue(Of T)(ByVal attr As VisualBasicAttributeData, i As Integer, name As String, kind As TypedConstantKind, v As T) Dim namedArg = attr.CommonNamedArguments(i) Assert.Equal(namedArg.Key, name) Dim arg = namedArg.Value Assert.Equal(arg.Kind, kind) Assert.True(IsEqual(arg, v)) End Sub Private Function IsEqual(Of T)(ByVal arg As TypedConstant, ByVal expected As T) As Boolean Select Case arg.Kind Case TypedConstantKind.Array Return AreEqual(arg.Values, expected) Case TypedConstantKind.Enum Return expected.Equals(arg.Value) Case TypedConstantKind.Type Dim typeSym = TryCast(arg.Value, TypeSymbol) If typeSym Is Nothing Then Return False End If Dim expTypeSym = TryCast(expected, TypeSymbol) If typeSym.Equals(expTypeSym) Then Return True End If ' TODO: improve the comparison mechanism for generic types. If typeSym.Kind = SymbolKind.NamedType AndAlso DirectCast(typeSym, NamedTypeSymbol).IsGenericType() Then Dim s1 = typeSym.ToDisplayString(SymbolDisplayFormat.TestFormat) Dim s2 = expected.ToString() If (s1 = s2) Then Return True End If End If Dim expType = TryCast(expected, Type) If expType Is Nothing Then Return False End If 'Can't always simply compare string as .ToString() is IL format Return IsEqual(typeSym, expType) Case Else 'Assert.Equal(expected, CType(arg.Value, T)) Return If(expected Is Nothing, arg.Value Is Nothing, expected.Equals(CType(arg.Value, T))) End Select End Function ''' For argument is not simple 'Type' (generic or array) Private Function IsEqual(typeSym As TypeSymbol, expType As Type) As Boolean '' namedType Dim typeSymTypeKind As TypeKind = typeSym.TypeKind If typeSymTypeKind = TypeKind.Interface OrElse typeSymTypeKind = TypeKind.Class OrElse typeSymTypeKind = TypeKind.Structure OrElse typeSymTypeKind = TypeKind.Delegate Then Dim namedType = DirectCast(typeSym, NamedTypeSymbol) ' name should be same if it's not generic (NO ByRef in attribute) If (namedType.Arity = 0) Then Return typeSym.Name = expType.Name End If ' generic If Not (expType.IsGenericType) Then Return False End If Dim nameOnly = expType.Name 'generic '1 Dim idx = expType.Name.LastIndexOfAny(New Char() {"`"c}) If (idx > 0) Then nameOnly = expType.Name.Substring(0, idx) End If If Not (typeSym.Name = nameOnly) Then Return False End If Dim expArgs = expType.GetGenericArguments() Dim actArgs = namedType.TypeArguments() If Not (expArgs.Count = actArgs.Length) Then Return False End If For i = 0 To expArgs.Count - 1 If Not IsEqual(actArgs(i), expArgs(i)) Then Return False End If Next Return True ' array type ElseIf typeSymTypeKind = TypeKind.Array Then If Not expType.IsArray Then Return False End If Dim arySym = DirectCast(typeSym, ArrayTypeSymbol) If Not IsEqual(arySym.ElementType, expType.GetElementType()) Then Return False End If If Not IsEqual(arySym.BaseType, expType.BaseType) Then Return False End If Return arySym.Rank = expType.GetArrayRank() End If Return False End Function ' Compare an Object with a TypedConstant. This compares the TypeConstant's value and ignores the TypeConstant's type. Private Function AreEqual(tc As ImmutableArray(Of TypedConstant), o As Object) As Boolean If o Is Nothing Then Return tc.IsDefault ElseIf tc.IsDefault Then Return False End If If Not o.GetType.IsArray Then Return False End If Dim a = DirectCast(o, Array) Dim ret As Boolean = True For i = 0 To a.Length - 1 Dim v = a.GetValue(i) Dim c = tc(i) ret = ret And IsEqual(c, v) Next Return ret End Function End Module