/
githubmirror
/
roslyn
Обзор
Документация
Войти
/
githubmirror
/
roslyn
Код
Запросы
0
Пакеты
0
Релизы
0
Аналитика
Безопасность
main
src/Compilers/VisualBasic/Test/Symbol/SymbolsTests/Retargeting/RetargetingTests.vb
3 263 строки
127 KB
Fredric Silberberg
Skip tests affected by https://github.com/dotnet/runtime/issues/117566.
13 июл 2025, 00:49
13 июл 2025, 00:49
041d768
Код
Авторство
О чём код?
' Licensed to the .NET Foundation under one or more agreements. ' The .NET Foundation licenses this file to you under the MIT license. ' See the LICENSE file in the project root for more information. Imports System.Collections.Immutable Imports Basic.Reference.Assemblies Imports Microsoft.CodeAnalysis.Test.Utilities Imports Microsoft.CodeAnalysis.VisualBasic.Symbols Imports Microsoft.CodeAnalysis.VisualBasic.Symbols.Retargeting Imports Roslyn.Test.Utilities Namespace Microsoft.CodeAnalysis.VisualBasic.UnitTests.Symbols #If Not Retargeting Then Public Class RetargetingTests Inherits BasicTestBase <Fact> Public Sub RetargetMembers() Dim compilation = CompilationUtils.CreateCompilationWithMscorlib40( <compilation> <file name="a.vb"><![CDATA[ Imports System.Runtime.InteropServices ' Explicit members. Class A Shared Sub New() End Sub Sub New() End Sub Public B Sub C(value As A) End Sub Function D(Of T)() As T End Function Property E Class F End Class Structure G End Structure Enum H Value End Enum Interface I End Interface <MarshalAs(UnmanagedType.SafeArray, SafeArraySubType:=VarEnum.VT_DISPATCH, SafeArrayUserDefinedSubType:=GetType(B))> Public MF As Integer Friend Function M(<MarshalAs(UnmanagedType.SafeArray, SafeArraySubType:=VarEnum.VT_DISPATCH, SafeArrayUserDefinedSubType:=GetType(B))> arg As Integer) _ As <MarshalAs(UnmanagedType.SafeArray, SafeArraySubType:=VarEnum.VT_DISPATCH, SafeArrayUserDefinedSubType:=GetType(B))> Integer Return 1 End Function End Class ' Implicit constructors. Class B Shared F = 1 Private G = 2 End Class ' Generic type. Class C(Of T) Sub M(Of U)(a As T, b As U) End Sub Function F() As C(Of A) End Function End Class ]]> </file> </compilation>) Dim sourceModule = compilation.SourceModule Dim sourceAssembly = DirectCast(sourceModule.ContainingAssembly, SourceAssemblySymbol) Dim sourceNamespace = sourceModule.GlobalNamespace Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace = retargetingModule.GlobalNamespace Dim sourceType As NamedTypeSymbol Dim retargetingType As NamedTypeSymbol Dim sourceMethod As MethodSymbol Dim retargetingMethod As MethodSymbol sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("A") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("A") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".cctor"), retargetingType.GetMethod(".cctor")) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckFields(sourceType.GetMember("B"), retargetingType.GetMember("B")) CheckFields(sourceType.GetMember("MF"), retargetingType.GetMember("MF")) CheckMethods(sourceType.GetMember("M"), retargetingType.GetMember("M")) sourceMethod = sourceType.GetMember(Of MethodSymbol)("C") retargetingMethod = retargetingType.GetMember(Of MethodSymbol)("C") CheckMethods(sourceMethod, retargetingMethod) CheckParameters(sourceMethod.Parameters(0), retargetingMethod.Parameters(0)) sourceMethod = sourceType.GetMember(Of MethodSymbol)("D") retargetingMethod = retargetingType.GetMember(Of MethodSymbol)("D") CheckMethods(sourceMethod, retargetingMethod) CheckTypeParameters(sourceMethod.TypeParameters(0), retargetingMethod.TypeParameters(0)) CheckTypeParameters(sourceMethod.ReturnType, retargetingMethod.ReturnType) CheckProperties(sourceType.GetMember("E"), retargetingType.GetMember("E")) CheckTypes(sourceType.GetMember("F"), retargetingType.GetMember("F")) CheckTypes(sourceType.GetMember("G"), retargetingType.GetMember("G")) CheckTypes(sourceType.GetMember("H"), retargetingType.GetMember("H")) CheckTypes(sourceType.GetMember("I"), retargetingType.GetMember("I")) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("B") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("B") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".cctor"), retargetingType.GetMethod(".cctor")) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("C") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("C") CheckTypes(sourceType, retargetingType) CheckTypeParameters(sourceType.TypeParameters(0), retargetingType.TypeParameters(0)) sourceMethod = sourceType.GetMember(Of MethodSymbol)("M") retargetingMethod = retargetingType.GetMember(Of MethodSymbol)("M") CheckMethods(sourceMethod, retargetingMethod) CheckTypeParameters(sourceMethod.TypeParameters(0), retargetingMethod.TypeParameters(0)) sourceMethod = sourceType.GetMember(Of MethodSymbol)("F") retargetingMethod = retargetingType.GetMember(Of MethodSymbol)("F") CheckMethods(sourceMethod, retargetingMethod) sourceType = DirectCast(sourceMethod.ReturnType, NamedTypeSymbol) retargetingType = DirectCast(retargetingMethod.ReturnType, NamedTypeSymbol) CheckTypes(sourceType.TypeArguments(0), retargetingType.TypeArguments(0)) End Sub Private Sub CheckTypes(source As Symbol, retargeting As Symbol) CheckUnderlyingMember(source, DirectCast(retargeting, RetargetingNamedTypeSymbol).UnderlyingNamedType) End Sub Private Sub CheckFields(source As Symbol, retargeting As Symbol) Dim a = DirectCast(source, FieldSymbol) Dim b = DirectCast(retargeting, RetargetingFieldSymbol) Dim aAssociated As Symbol = a.AssociatedSymbol Dim bAssociated As Symbol = b.AssociatedSymbol If aAssociated Is Nothing Then Assert.Null(bAssociated) ElseIf aAssociated.Kind = SymbolKind.Property Then CheckProperties(aAssociated, bAssociated) Else CheckEvent(aAssociated, bAssociated) End If Assert.Equal(a.Name, b.Name) CheckUnderlyingMember(a, b.UnderlyingField) CheckMarshallingInformation(a.MarshallingInformation, b.MarshallingInformation) End Sub Private Sub CheckMarshallingInformation(a As MarshalPseudoCustomAttributeData, b As MarshalPseudoCustomAttributeData) Assert.Equal(a Is Nothing, b Is Nothing) If a IsNot Nothing Then CheckTypes(DirectCast(a.TryGetSafeArrayElementUserDefinedSubtype(), TypeSymbol), DirectCast(b.TryGetSafeArrayElementUserDefinedSubtype(), TypeSymbol)) End If End Sub Private Sub CheckMethods(source As Symbol, retargeting As Symbol) Dim a = DirectCast(source, MethodSymbol) Dim b = DirectCast(retargeting, RetargetingMethodSymbol) CheckUnderlyingMember(a, b.UnderlyingMethod) CheckMarshallingInformation(a.ReturnTypeMarshallingInformation, b.ReturnTypeMarshallingInformation) End Sub Private Sub CheckProperties(source As Symbol, retargeting As Symbol) CheckUnderlyingMember(source, DirectCast(retargeting, RetargetingPropertySymbol).UnderlyingProperty) End Sub Private Sub CheckTypeParameters(source As Symbol, retargeting As Symbol) CheckUnderlyingMember(source, DirectCast(retargeting, RetargetingTypeParameterSymbol).UnderlyingTypeParameter) End Sub Private Sub CheckParameters(source As Symbol, retargeting As Symbol) Dim a = DirectCast(source, ParameterSymbol) Dim b = DirectCast(retargeting, RetargetingParameterSymbol) CheckUnderlyingMember(a, b.UnderlyingParameter) CheckMarshallingInformation(a.MarshallingInformation, b.MarshallingInformation) End Sub Private Sub CheckEvent(source As Symbol, retargeting As Symbol) CheckUnderlyingMember(source, DirectCast(retargeting, RetargetingEventSymbol).UnderlyingEvent) End Sub Private Sub CheckUnderlyingMember(source As Symbol, underlying As Symbol) Assert.NotNull(source) Assert.NotNull(underlying) Assert.Same(source, underlying) Assert.Equal(source.IsImplicitlyDeclared, underlying.IsImplicitlyDeclared) End Sub <WorkItem(542571, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/542571")> <Fact> Public Sub RetargetExplicitImplementationDifferentModule() Dim source1 = <compilation name="assembly1"> <file name="source1.vb"> Public Interface I(Of T) Sub M(Of U)(o As I(Of U)) Sub N(o As I(Of T)) ReadOnly Property P As I(Of T) End Interface Public Class A End Class </file> </compilation> Dim compilation1_v1 = CreateCompilationWithMscorlib40(source1) Dim compilation1_v2 = CreateCompilationWithMscorlib40(source1) Dim source2 = <compilation name="assembly2"> <file name="source2.vb"> Class B Implements I(Of A) Public Sub M(Of U)(o As I(Of U)) Implements I(Of A).M End Sub Public Sub N(o As I(Of A)) Implements I(Of A).N End Sub Public ReadOnly Property P As I(Of A) Implements I(Of A).P Get Return Nothing End Get End Property End Class Class C(Of CT) Implements I(Of CT) Public Sub M(Of U)(o As I(Of U)) Implements I(Of CT).M End Sub Public Sub N(o As I(Of CT)) Implements I(Of CT).N End Sub Public ReadOnly Property P As I(Of CT) Implements I(Of CT).P Get Return Nothing End Get End Property End Class </file> </compilation> Dim compilation2 = CreateCompilationWithMscorlib40AndReferences(source2, {New VisualBasicCompilationReference(compilation1_v1)}) Dim compilation2Ref = New VisualBasicCompilationReference(compilation2) Dim compilation3 = CreateCompilationWithMscorlib40AndReferences( <compilation name="assembly3"> <file name="source3.vb"> Public Interface I(Of T) </file> </compilation>, {compilation2Ref, New VisualBasicCompilationReference(compilation1_v2)}) Dim assembly2 = compilation3.GetReferencedAssemblySymbol(compilation2Ref) Dim implemented_m As MethodSymbol Dim implemented_n As MethodSymbol Dim implemented_p As PropertySymbol Dim b = assembly2.GetTypeByMetadataName("B") Dim m = b.GetMember(Of MethodSymbol)("M") implemented_m = m.ExplicitInterfaceImplementations(0) Assert.Equal("Sub I(Of A).M(Of U)(o As I(Of U))", implemented_m.ToTestDisplayString()) Dim a_v2 = compilation1_v2.GetTypeByMetadataName("A") Dim i_a_v2 = compilation1_v2.GetTypeByMetadataName("I`1").Construct(ImmutableArray.Create(Of TypeSymbol)(a_v2)) Dim i_a_m_v2 = i_a_v2.GetMember(Of MethodSymbol)("M") Assert.Equal(i_a_m_v2, implemented_m) Dim n = b.GetMember(Of MethodSymbol)("N") implemented_n = n.ExplicitInterfaceImplementations(0) Assert.Equal("Sub I(Of A).N(o As I(Of A))", implemented_n.ToTestDisplayString()) Dim i_a_n_v2 = i_a_v2.GetMember(Of MethodSymbol)("N") Assert.Equal(i_a_n_v2, implemented_n) Dim p = b.GetMember(Of PropertySymbol)("P") implemented_p = p.ExplicitInterfaceImplementations(0) Assert.Equal("ReadOnly Property I(Of A).P As I(Of A)", implemented_p.ToTestDisplayString()) Dim i_a_p_v2 = i_a_v2.GetMember(Of PropertySymbol)("P") Assert.Equal(i_a_p_v2, implemented_p) Dim c = assembly2.GetTypeByMetadataName("C`1") Dim i_ct_v2 = compilation1_v2.GetTypeByMetadataName("I`1").Construct(ImmutableArray.Create(Of TypeSymbol)(c.TypeParameters(0))) implemented_m = c.GetMember(Of MethodSymbol)("M").ExplicitInterfaceImplementations(0) Assert.Equal("Sub I(Of CT).M(Of U)(o As I(Of U))", implemented_m.ToTestDisplayString()) Dim i_ct_m_v2 = i_ct_v2.GetMember(Of MethodSymbol)("M") Assert.Equal(i_ct_m_v2, implemented_m) implemented_n = c.GetMember(Of MethodSymbol)("N").ExplicitInterfaceImplementations(0) Assert.Equal("Sub I(Of CT).N(o As I(Of CT))", implemented_n.ToTestDisplayString()) Dim i_ct_n_v2 = i_ct_v2.GetMember(Of MethodSymbol)("N") Assert.Equal(i_ct_n_v2, implemented_n) implemented_p = c.GetMember(Of PropertySymbol)("P").ExplicitInterfaceImplementations(0) Assert.Equal("ReadOnly Property I(Of CT).P As I(Of CT)", implemented_p.ToTestDisplayString()) Dim i_ct_p_v2 = i_ct_v2.GetMember(Of PropertySymbol)("P") Assert.Equal(i_ct_p_v2, implemented_p) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetInvalidEnumUnderlyingType_Implicit() Dim source = <compilation name="test"> <file name="a.vb"> Public Enum E A End Enum </file> </compilation> Dim comp = CreateEmptyCompilation(source) comp.VerifyDiagnostics( Diagnostic(ERRID.ERR_UndefinedType1, "E").WithArguments("System.Int32"), Diagnostic(ERRID.ERR_UndefinedType1, <![CDATA[Public Enum E A End Enum]]>.Value.Replace(vbLf, vbCrLf)).WithArguments("System.Void"), Diagnostic(ERRID.ERR_TypeRefResolutionError3, "E").WithArguments("System.Enum", "test.dll")) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("E") Assert.Equal(0, sourceType.Interfaces.Length) Assert.Equal(TypeKind.Error, sourceType.BaseType.TypeKind) Assert.Equal(SpecialType.System_Enum, sourceType.BaseType.SpecialType) Assert.Equal(TypeKind.Error, sourceType.EnumUnderlyingType.TypeKind) Assert.Equal(SpecialType.System_Int32, sourceType.EnumUnderlyingType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) retargetingAssembly.SetCorLibrary(sourceAssembly.CorLibrary) ' Need to do this explicitly since our retargeting assembly wasn't constructed using the real mechanism. Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("E") Assert.Equal(0, retargetingType.Interfaces.Length) Assert.Equal(TypeKind.Error, retargetingType.BaseType.TypeKind) Assert.Equal(SpecialType.System_Enum, retargetingType.BaseType.SpecialType) Assert.Equal(TypeKind.Error, retargetingType.EnumUnderlyingType.TypeKind) Assert.Equal(SpecialType.System_Int32, retargetingType.EnumUnderlyingType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetInvalidEnumUnderlyingType_Explicit() Dim source = <compilation name="test"> <file name="a.vb"> Public Enum E As Short A End Enum </file> </compilation> Dim comp = CreateEmptyCompilation(source) comp.VerifyDiagnostics( Diagnostic(ERRID.ERR_UndefinedType1, "Short").WithArguments("System.Int16"), Diagnostic(ERRID.ERR_UndefinedType1, <![CDATA[Public Enum E As Short A End Enum]]>.Value.Replace(vbLf, vbCrLf)).WithArguments("System.Void"), Diagnostic(ERRID.ERR_TypeRefResolutionError3, "E").WithArguments("System.Enum", "test.dll")) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("E") Assert.Equal(0, sourceType.Interfaces.Length) Assert.Equal(TypeKind.Error, sourceType.BaseType.TypeKind) Assert.Equal(SpecialType.System_Enum, sourceType.BaseType.SpecialType) Assert.Equal(TypeKind.Error, sourceType.EnumUnderlyingType.TypeKind) Assert.Equal(SpecialType.System_Int16, sourceType.EnumUnderlyingType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) retargetingAssembly.SetCorLibrary(sourceAssembly.CorLibrary) ' Need to do this explicitly since our retargeting assembly wasn't constructed using the real mechanism. Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("E") Assert.Equal(0, retargetingType.Interfaces.Length) Assert.Equal(TypeKind.Error, retargetingType.BaseType.TypeKind) Assert.Equal(SpecialType.System_Enum, retargetingType.BaseType.SpecialType) Assert.Equal(TypeKind.Error, retargetingType.EnumUnderlyingType.TypeKind) Assert.Equal(SpecialType.System_Int16, retargetingType.EnumUnderlyingType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetInvalidInterfaceType_Class() Dim source = <compilation> <file name="a.vb"> Public Class Test Implements Short End Class </file> </compilation> Dim comp = CreateCompilationWithMscorlib40(source) comp.VerifyDiagnostics( Diagnostic(ERRID.ERR_BadImplementsType, "Short")) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, sourceType.Interfaces.Length) Assert.Equal(SpecialType.System_Object, sourceType.BaseType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, retargetingType.Interfaces.Length) Assert.Equal(SpecialType.System_Object, retargetingType.BaseType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetMissingInterfaceType_Class() Dim source = <compilation name="test"> <file name="a.vb"> Public Class Test Implements Short End Class </file> </compilation> Dim comp = CreateEmptyCompilation(source) AssertTheseDiagnostics(comp, <expected> BC30002: Type 'System.Void' is not defined. Public Class Test ~~~~~~~~~~~~~~~~~~ BC31091: Import of type 'Object' from assembly or module 'test.dll' failed. Public Class Test ~~~~ BC30002: Type 'System.Int16' is not defined. Implements Short ~~~~~ </expected>) ' NOTE: slightly different from C# result, because Short can't be re-interpreted as a base type. Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, sourceType.Interfaces.Length) Assert.Equal(SpecialType.System_Object, sourceType.BaseType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, retargetingType.Interfaces.Length) Assert.Equal(SpecialType.System_Object, retargetingType.BaseType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetInvalidInterfaceType_Struct() Dim source = <compilation> <file name="a.vb"> Public Structure Test Implements Short End Structure </file> </compilation> Dim comp = CreateCompilationWithMscorlib40(source) comp.VerifyDiagnostics( Diagnostic(ERRID.ERR_BadImplementsType, "Short")) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, sourceType.Interfaces.Length) Assert.Equal(SpecialType.System_ValueType, sourceType.BaseType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, retargetingType.Interfaces.Length) Assert.Equal(SpecialType.System_ValueType, retargetingType.BaseType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> <WorkItem(609515, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/609515")> Public Sub RetargetMissingInterfaceType_Struct() Dim source = <compilation name="test"> <file name="a.vb"> Public Structure Test Implements Short End Structure </file> </compilation> Dim comp = CreateEmptyCompilation(source) AssertTheseDiagnostics(comp, <expected> BC30002: Type 'System.Void' is not defined. Public Structure Test ~~~~~~~~~~~~~~~~~~~~~~ BC31091: Import of type 'ValueType' from assembly or module 'test.dll' failed. Public Structure Test ~~~~ BC30002: Type 'System.Int16' is not defined. Implements Short ~~~~~ </expected>) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, sourceType.Interfaces.Length) Assert.Equal(TypeKind.Error, sourceType.BaseType.TypeKind) Assert.Equal(SpecialType.System_ValueType, sourceType.BaseType.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, retargetingType.Interfaces.Length) Assert.Equal(TypeKind.Error, retargetingType.BaseType.TypeKind) Assert.Equal(SpecialType.System_ValueType, retargetingType.BaseType.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> Public Sub RetargetInvalidInterfaceType_Interface() Dim source = <compilation> <file name="a.vb"> Public Interface Test Inherits Short End Interface </file> </compilation> Dim comp = CreateCompilationWithMscorlib40(source) AssertTheseDiagnostics(comp, <expected> BC30354: Interface can inherit only from another interface. Inherits Short ~~~~~ </expected>) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, sourceType.Interfaces.Length) Assert.Null(sourceType.BaseType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(0, retargetingType.Interfaces.Length) Assert.Null(retargetingType.BaseType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> <WorkItem(609515, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/609515")> Public Sub RetargetMissingInterfaceType_Interface() Dim source = <compilation> <file name="a.vb"> Public Interface Test Inherits Short End Interface </file> </compilation> Dim comp = CreateEmptyCompilation(source) comp.VerifyDiagnostics( Diagnostic(ERRID.ERR_UndefinedType1, "Short").WithArguments("System.Int16")) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, sourceType.Interfaces.Length) Assert.Null(sourceType.BaseType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("Test") Assert.Equal(1, retargetingType.Interfaces.Length) Assert.Null(retargetingType.BaseType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> <WorkItem(609519, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/609519")> Public Sub RetargetInvalidConstraint() Dim source = <compilation> <file name="a.vb"> Public Class C(Of T As Short) End Class </file> </compilation> Dim comp = CreateCompilationWithMscorlib40(source) comp.AssertTheseDiagnostics(<expected> BC32048: Type constraint 'Short' must be either a class, interface or type parameter. Public Class C(Of T As Short) ~~~~~ </expected>) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("C") Dim sourceTypeParameter = sourceType.TypeParameters.Single() Dim sourceTypeParameterConstraint = sourceTypeParameter.ConstraintTypes.Single() Assert.Equal(SpecialType.System_Int16, sourceTypeParameterConstraint.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("C") Dim retargetingTypeParameter = retargetingType.TypeParameters.Single() Dim retargetingTypeParameterConstraint = retargetingTypeParameter.ConstraintTypes.Single() Assert.Equal(SpecialType.System_Int16, retargetingTypeParameterConstraint.SpecialType) End Sub <Fact> <WorkItem(604878, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/604878")> <WorkItem(609519, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/609519")> Public Sub RetargetMissingConstraint() Dim source = <compilation name="test"> <file name="a.vb"> Public Class C(Of T As Short) End Class </file> </compilation> Dim comp = CreateEmptyCompilation(source) comp.AssertTheseDiagnostics(<expected> BC30002: Type 'System.Void' is not defined. Public Class C(Of T As Short) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ BC31091: Import of type 'Object' from assembly or module 'test.dll' failed. Public Class C(Of T As Short) ~ BC30002: Type 'System.Int16' is not defined. Public Class C(Of T As Short) ~~~~~ BC31091: Import of type 'Short' from assembly or module 'test.dll' failed. Public Class C(Of T As Short) ~~~~~ </expected>) Dim sourceAssembly = DirectCast(comp.Assembly, SourceAssemblySymbol) Dim sourceType = sourceAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("C") Dim sourceTypeParameter = sourceType.TypeParameters.Single() Dim sourceTypeParameterConstraint = sourceTypeParameter.ConstraintTypes.Single() Assert.Equal(TypeKind.Error, sourceTypeParameterConstraint.TypeKind) Assert.Equal(SpecialType.System_Int16, sourceTypeParameterConstraint.SpecialType) Dim retargetingAssembly = New RetargetingAssemblySymbol(sourceAssembly, isLinked:=False) Dim retargetingType = retargetingAssembly.GlobalNamespace.GetMember(Of NamedTypeSymbol)("C") Dim retargetingTypeParameter = retargetingType.TypeParameters.Single() Dim retargetingTypeParameterConstraint = retargetingTypeParameter.ConstraintTypes.Single() Assert.Equal(TypeKind.Error, retargetingTypeParameterConstraint.TypeKind) Assert.Equal(SpecialType.System_Int16, retargetingTypeParameterConstraint.SpecialType) End Sub <Fact> Public Sub Retarget_Non_GenericTypes() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Imports ClassLibrary1 Imports ClassLibrary1.TestNS Module Module1 Sub Main() Dim Usage_Class As New NewClass Usage_Class.TestProperty = 101 With Usage_Class ._Field = 102 If .ReadOnlyProperty <> 102 Then Console.WriteLine("Problem") End If .WriteOnlyProperty = 103 If .ReadOnlyProperty <> 103 Then Console.WriteLine("Problem") End If End With Console.WriteLine("Success") End Sub End Module 'We need to use each of the items in the Class Library Class NewClass Inherits ClassLibrary1.TestClass End Class <Test> Class NewClass_Using_Attribute End Class Class NewClass_ImplementingInterface Implements ClassLibrary1.TestInterface Public Sub Sub_In_Interface(y As String) Implements ClassLibrary1.TestInterface.Sub_In_Interface Console.Writeline("Success") End Sub Public Function Function_In_Interface(x As Integer) As Boolean Implements ClassLibrary1.TestInterface.Function_In_Interface Return True End Function End Class Class New_InheritedAttribute Inherits ClassLibrary1.TestAttribute End Class Module Module_Usage Sub TestMethod() Dim x As New ClassLibrary1.Class_With_Attribute 'Structure Dim y As New ClassLibrary1.TestStructure y._int_In_Structure = 102 If y._int_In_Structure <> 102 Then Console.WriteLine("Problem") End If y.String_Property = "Success" Console.WriteLine("Property:" & y.String_Property) End Sub Sub test_Constraints() Dim t1 As New ClassLibrary1.TestClass Dim t2 As New ClassLibrary1.TestStructure Dim t3 As New ClassLibrary1.Test_Enum Dim t4 As New ClassLibrary1.TestNS.Class_In_NS Dim t5 As New ClassLibrary1.NestedTypeBase Dim t5_1 As New ClassLibrary1.NestedTypeDerived Dim t6 As New ClassLibrary1.Structure_With_Attribute Dim c1 = ClassLibrary1.Test_Module.Test_Constant Dim d1 As ClassLibrary1.Test_Module.DelSub Dim d2 As ClassLibrary1.Test_Module.DelFunction d1 = AddressOf goo d2 = AddressOf bar End Sub Sub Usage_Attribute() Dim x As Structure_With_Attribute x._int_In_Structure = 1 End Sub Sub TestEnum() Dim EnumValue = Test_Enum.Item1 EnumValue = Test_Enum.Item3 If ClassLibrary1.Test_Module.Test_Constant <> 101 Then Console.WriteLine("Problem") End If Dim DelSub As ClassLibrary1.Test_Module.DelSub = AddressOf DelTestMethod DelSub.Invoke(1) Dim DelFunc As ClassLibrary1.Test_Module.DelFunction = AddressOf DelTestMethod Dim xresult = DelFunc("Test") End Sub Sub DelTestMethod(x As Integer) Console.WriteLine("Success") End Sub Function DelTestMethod(x As String) As Boolean If x = "Test" Then Return True Else Return False End If End Function Sub NestedTypes() Dim xb As New ClassLibrary1.NestedTypeBase Dim xd As New ClassLibrary1.NestedTypeDerived If TypeOf (xd) Is ClassLibrary1.NestedTypeDerived Then Console.WriteLine("Success") End If End Sub Sub TestNs() Dim x As New Class_In_NS If x.SuccessProperty = True Then Console.WriteLine("Success") End If End Sub Private Sub goo() Console.WriteLine("goo") End Sub Private Function bar(x As String) As Boolean Return True End Function End Module Class ABC End Class ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Imports System Namespace ClassLibrary1 Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Public Structure TestStructure Public _int_In_Structure As Integer Public Property String_Property As String End Structure Public Interface TestInterface Sub Sub_In_Interface(y As String) Function Function_In_Interface(x As Integer) As Boolean End Interface Public Class TestAttribute Inherits Attribute End Class <Test> Public Class Class_With_Attribute End Class <Test> Public Structure Structure_With_Attribute Public _int_In_Structure As Integer Public Property String_Property As String End Structure 'Test Enum Public Enum Test_Enum Item1 Item3 = 3 End Enum Public Module Test_Module Public Const Test_Constant As Integer = 101 Public Delegate Sub DelSub(x As Integer) Public Delegate Function DelFunction(x As String) As Boolean End Module Public Class NestedTypeBase End Class Public Class NestedTypeDerived Inherits NestedTypeBase End Class Namespace TestNS Public Class Class_In_NS Public Property SuccessProperty As Boolean = True End Class End Namespace End Namespace ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors without retargeting Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[Success ]]>) main_NoRetarget.VerifyDiagnostics() 'Retargetted - should result in No additional Errors also and same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[Success ]]>) Main_Retarget.VerifyDiagnostics() 'Check the retargeting symbol information Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace As SourceNamespaceSymbol = CType(SourceModuleReference.GlobalNamespace.GetNamespace("ClassLibrary1"), SourceNamespaceSymbol) Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace As RetargetingNamespaceSymbol = CType(retargetingModule.GlobalNamespace.GetNamespace("ClassLibrary1"), RetargetingNamespaceSymbol) 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass") CheckTypes(sourceType, retargetingType) ' CheckMethods(sourceType.GetMethod(".cctor"), retargetingType.GetMethod(".cctor")) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckFields(sourceType.GetMember("_Field"), retargetingType.GetMember("_Field")) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) CheckProperties(sourceType.GetMember("ReadOnlyProperty"), retargetingType.GetMember("ReadOnlyProperty")) CheckProperties(sourceType.GetMember("WriteOnlyProperty"), retargetingType.GetMember("WriteOnlyProperty")) 'Structure sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") CheckTypes(sourceType, retargetingType) CheckFields(sourceType.GetMember("_int_In_Structure"), retargetingType.GetMember("_int_In_Structure")) CheckProperties(sourceType.GetMember("String_Property"), retargetingType.GetMember("String_Property")) Assert.Equal(sourceType.GetAttributes.Length, retargetingType.GetAttributes.Length) Assert.Equal(0, sourceType.GetAttributes.Length) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Structure_With_Attribute") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Structure_With_Attribute") CheckTypes(sourceType, retargetingType) CheckFields(sourceType.GetMember("_int_In_Structure"), retargetingType.GetMember("_int_In_Structure")) CheckProperties(sourceType.GetMember("String_Property"), retargetingType.GetMember("String_Property")) 'Same Structure Content but different with/without attribute Assert.NotSame(sourceNamespace.GetMember(Of NamedTypeSymbol)("Structure_With_Attribute"), sourceNamespace.GetMember(Of NamedTypeSymbol)("TestStructure")) Assert.Equal(1, sourceType.GetAttributes.Length) 'Attribute sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestAttribute") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestAttribute") CheckTypes(sourceType, retargetingType) Assert.Equal(sourceType.GetAttributeTarget, retargetingType.GetAttributeTarget) 'Enums 'Public Enum Test_Enum sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Test_Enum") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Test_Enum") CheckTypes(sourceType, retargetingType) Assert.Equal(4, sourceType.GetMembers.Length) Assert.Equal(sourceType.GetMembers.Length, retargetingType.GetMembers.Length) 'Modules - for VB sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Test_Module") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Test_Module") CheckTypes(sourceType, retargetingType) Assert.Equal(sourceType.GetMembers.Length, retargetingType.GetMembers.Length) Assert.Equal(3, sourceType.GetMembers.Length) 'Delegates Assert.Equal(TypeKind.Delegate, CType(sourceType.GetMembers.Item(1), SourceNamedTypeSymbol).TypeKind) Assert.Equal(TypeKind.Delegate, CType(sourceType.GetMembers.Item(2), SourceNamedTypeSymbol).TypeKind) CheckFields(sourceType.GetMembers.Item(0), retargetingType.GetMembers.Item(0)) 'Const CheckTypes(sourceType.GetMembers.Item(1), retargetingType.GetMembers.Item(1)) 'Delegate CheckTypes(sourceType.GetMembers.Item(2), retargetingType.GetMembers.Item(2)) 'Delegate End Sub <Fact> Public Sub Retarget_GenericTypes() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Imports ClassLibrary1 Imports ClassLibrary1.TestNS Module Module1 Sub Main() Dim Usage_Class As New NewClass Usage_Class.TestProperty = 101 With Usage_Class ._Field = 102 If .ReadOnlyProperty <> 102 Then Console.WriteLine("Problem") End If .WriteOnlyProperty = 103 If .ReadOnlyProperty <> 103 Then Console.WriteLine("Problem") End If End With Console.WriteLine("Success") End Sub End Module 'We need to use each of the items in the Class Library Class NewClass Inherits ClassLibrary1.TestClass End Class <ClassLibrary1.Test> Class NewClass_Using_Attribute End Class Class NewClass_ImplementingInterface Implements ClassLibrary1.TestInterface Public Sub Sub_In_Interface(y As String) Implements ClassLibrary1.TestInterface.Sub_In_Interface Console.WriteLine("Success") End Sub Public Function Function_In_Interface(x As Integer) As Boolean Implements ClassLibrary1.TestInterface.Function_In_Interface Return True End Function End Class Class New_InheritedAttribute Inherits ClassLibrary1.TestAttribute End Class Module Module_Usage Sub TestMethod() Dim x As New ClassLibrary1.Class_With_Attribute 'Structure Dim y As New ClassLibrary1.TestStructure y._int_In_Structure = 102 If y._int_In_Structure <> 102 Then Console.WriteLine("Problem") End If y.String_Property = "Success" Console.WriteLine("Property:" & y.String_Property) End Sub Sub test_Constraints() Dim t1 As New ClassLibrary1.Generic_Test_Class(Of NewClass) Dim t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of ClassLibrary1.TestInterface) Dim t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of NewClass) Dim t3_1 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.Generic_Test_Class(Of Integer)) Dim t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of ClassLibrary1.TestClass) Dim t4_1 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of NewClass) Dim t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ClassLibrary1.TestClass) #If CompErrorTest Then Dim f_t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of NewClass) Dim f_t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.TestInterface) Dim f_t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of Integer) Dim f_t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ABC) #End If End Sub Sub Usage_Attribute() Dim x As ClassLibrary1.Structure_With_Attribute x._int_In_Structure = 1 End Sub Sub TestEnum() Dim EnumValue = ClassLibrary1.Test_Enum.Item1 EnumValue = ClassLibrary1.Test_Enum.Item3 If ClassLibrary1.Test_Module.Test_Constant <> 101 Then Console.WriteLine("Problem") End If Dim DelSub As ClassLibrary1.Test_Module.DelSub = AddressOf DelTestMethod DelSub.Invoke(1) Dim DelFunc As ClassLibrary1.Test_Module.DelFunction = AddressOf DelTestMethod Dim xresult = DelFunc("Test") End Sub Sub DelTestMethod(x As Integer) Console.WriteLine("Success") End Sub Function DelTestMethod(x As String) As Boolean If x = "Test" Then Return True Else Return False End If End Function Sub NestedTypes() Dim xb As New ClassLibrary1.NestedTypeBase Dim xd As New ClassLibrary1.NestedTypeDerived If TypeOf (xd) Is ClassLibrary1.NestedTypeDerived Then Console.WriteLine("Success") End If End Sub Sub TestNs() Dim x As New Class_In_NS If x.SuccessProperty = True Then Console.WriteLine("Success") End If End Sub End Module Class ABC End Class ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Imports System Namespace ClassLibrary1 Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Public Structure TestStructure Public _int_In_Structure As Integer Public Property String_Property As String End Structure Public Interface TestInterface Sub Sub_In_Interface(y As String) Function Function_In_Interface(x As Integer) As Boolean End Interface Public Class TestAttribute Inherits Attribute End Class <Test> Public Class Class_With_Attribute End Class <Test> Public Structure Structure_With_Attribute Public _int_In_Structure As Integer Public Property String_Property As String End Structure 'Test Enum Public Enum Test_Enum Item1 Item3 = 3 End Enum Public Module Test_Module Public Const Test_Constant As Integer = 101 Public Delegate Sub DelSub(x As Integer) Public Delegate Function DelFunction(x As String) As Boolean End Module 'Generic Types Public Class Generic_Test_Class(Of t) Public Function xyz() As Integer Return True End Function End Class 'Constrained Public Class Generic_Test_Class_Constrained_Specific(Of t As TestClass) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Interface(Of t As TestInterface) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_New(Of t As New) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Multiple(Of t As {New, TestClass}) Public Function xyz() As Integer Return True End Function End Class Public Class NestedTypeBase End Class Public Class NestedTypeDerived Inherits NestedTypeBase End Class Namespace TestNS Public Class Class_In_NS Public Property SuccessProperty As Boolean = True End Class End Namespace End Namespace ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[Success ]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also and same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[Success ]]>) Main_Retarget.VerifyDiagnostics() 'Check the retargeting symbol information Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace As SourceNamespaceSymbol = CType(SourceModuleReference.GlobalNamespace.GetNamespace("ClassLibrary1"), SourceNamespaceSymbol) Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace As RetargetingNamespaceSymbol = CType(retargetingModule.GlobalNamespace.GetNamespace("ClassLibrary1"), RetargetingNamespaceSymbol) 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing 'Generic Types sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class") CheckTypes(sourceType, retargetingType) 'Check the Type Parameters Assert.Equal(sourceType.TypeParameters.Length, retargetingType.TypeParameters.Length) For i = 0 To sourceType.TypeParameters.Length - 1 CheckTypeParameters(sourceType.TypeParameters(i), retargetingType.TypeParameters(i)) Next 'Single Constraints sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class_Constrained_Interface") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class_Constrained_Interface") CheckTypes(sourceType, retargetingType) 'Check the Type Parameters Assert.Equal(sourceType.TypeParameters.Length, retargetingType.TypeParameters.Length) Assert.Equal(1, sourceType.TypeParameters(0).ConstraintTypes.Length) Assert.Equal(sourceType.TypeParameters(0).ConstraintTypes.Length, retargetingType.TypeParameters(0).ConstraintTypes.Length) Assert.False(sourceType.TypeParameters(0).HasConstructorConstraint) Assert.Equal(sourceType.TypeParameters(0).HasConstructorConstraint, retargetingType.TypeParameters(0).HasConstructorConstraint) For i = 0 To sourceType.TypeParameters(0).ConstraintTypes.Length - 1 CheckTypes(sourceType.TypeParameters(0).ConstraintTypes(i), retargetingType.TypeParameters(0).ConstraintTypes(i)) Next Assert.Equal("TestInterface", CType(sourceType.TypeParameters(0).ConstraintTypes(0), SourceNamedTypeSymbol).Name) 'Multiple Constraints sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class_Constrained_Multiple") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Generic_Test_Class_Constrained_Multiple") CheckTypes(sourceType, retargetingType) 'Check the Type Parameters Assert.Equal(sourceType.TypeParameters.Length, retargetingType.TypeParameters.Length) Assert.Equal(1, sourceType.TypeParameters(0).ConstraintTypes.Length) Assert.Equal(sourceType.TypeParameters(0).ConstraintTypes.Length, retargetingType.TypeParameters(0).ConstraintTypes.Length) Assert.True(sourceType.TypeParameters(0).HasConstructorConstraint) Assert.Equal(sourceType.TypeParameters(0).HasConstructorConstraint, retargetingType.TypeParameters(0).HasConstructorConstraint) For i = 0 To sourceType.TypeParameters.Length - 1 CheckTypeParameters(sourceType.TypeParameters(i), retargetingType.TypeParameters(i)) CheckTypes(sourceType.TypeParameters(0).ConstraintTypes(i), retargetingType.TypeParameters(0).ConstraintTypes(i)) Next Assert.Equal("TestClass", CType(sourceType.TypeParameters(0).ConstraintTypes(0), SourceNamedTypeSymbol).Name) End Sub <Fact> Public Sub Retarget_Scoping() 'Retargeting symbols occurs for types even if inaccessible 'Diagnostics are checked to verify semantic behavior Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Module Module1 Sub Main() Dim Usage_Class As TestClass = nothing Usage_Class.TestProperty = 101 With Usage_Class ._Field = 102 If .ReadOnlyProperty <> 102 Then Console.WriteLine("Problem") End If .WriteOnlyProperty = 103 If .ReadOnlyProperty <> 103 Then Console.WriteLine("Problem") End If End With Dim Usage_Struct As TestStructure = nothing Usage_Struct._int_In_Structure = 1 Usage_Struct.PrivateField = False 'This is error End Sub Dim x as TestInterface End Module Class C1 Implements TestInterface Public Function Function_In_Interface(x As Integer) As Boolean Implements TestInterface.Function_In_Interface Return True End Function Public Sub Sub_In_Interface(y As String) Implements TestInterface.Sub_In_Interface Console.WriteLine("Success" & y.tostring()) End Sub End Class Class C1_Private Implements TestInterface Public Function Function_In_Interface(x As Integer) As Boolean Implements TestInterface.Function_In_Interface Return True End Function Public Sub Sub_In_Interface(y As String) Implements TestInterface.Sub_In_Interface Console.WriteLine("Success" & y.tostring()) End Sub End Class ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Friend Structure TestStructure Public _int_In_Structure As Integer Public Property String_Property As String Private PrivateField As Boolean Friend Sub FriendMethod() End Sub End Structure Friend Interface TestInterface Sub Sub_In_Interface(y As String) Function Function_In_Interface(x As Integer) As Boolean End Interface Class ContainingClass Private Class PrivateTestClass Public _int_In_Structure As Integer Public Property String_Property As String Private PrivateField As Boolean Friend Sub FriendMethod() End Sub End Class End Class ]]> </file> </compilation> 'Check Expected Behavior Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibraryMetaData = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CreateCompilationWithMscorlib40AndVBRuntime(source, additionalRefs:={referenceLibraryMetaData}) '//Retargetted Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) Dim Main_Retarget = CreateCompilationWithMscorlib40AndVBRuntime(source, additionalRefs:={RetargetReference}, options:=TestOptions.ReleaseExe) 'Check the retargeting symbol information Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace As SourceNamespaceSymbol = CType(SourceModuleReference.GlobalNamespace, SourceNamespaceSymbol) Dim retargetingAssembly = Main_Retarget.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace As RetargetingNamespaceSymbol = CType(retargetingModule.GlobalNamespace, RetargetingNamespaceSymbol) 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing Dim sourceMethod As MethodSymbol = Nothing Dim retargetingMethod As MethodSymbol = Nothing 'Public With Different Accessible Member sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckFields(sourceType.GetMember("_Field"), retargetingType.GetMember("_Field")) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) CheckProperties(sourceType.GetMember("ReadOnlyProperty"), retargetingType.GetMember("ReadOnlyProperty")) CheckProperties(sourceType.GetMember("WriteOnlyProperty"), retargetingType.GetMember("WriteOnlyProperty")) 'Friend Type with different accessible Members sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckProperties(sourceType.GetMember("String_Property"), retargetingType.GetMember("String_Property")) CheckFields(sourceType.GetMember("_int_In_Structure"), retargetingType.GetMember("_int_In_Structure")) 'Public member in Private Type CheckFields(sourceType.GetMember("PrivateField"), retargetingType.GetMember("PrivateField")) 'Private member in Private Type CheckMethods(sourceType.GetMember("FriendMethod"), retargetingType.GetMember("FriendMethod")) 'Friend member in Private Type 'Private Type with different accessible Members- Private Type need to be in a containing class to avoid compile error sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("ContainingClass").GetMember(Of NamedTypeSymbol)("PrivateTestClass") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("ContainingClass").GetMember(Of NamedTypeSymbol)("PrivateTestClass") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckProperties(sourceType.GetMember("String_Property"), retargetingType.GetMember("String_Property")) CheckFields(sourceType.GetMember("_int_In_Structure"), retargetingType.GetMember("_int_In_Structure")) 'Public member in Private Type CheckFields(sourceType.GetMember("PrivateField"), retargetingType.GetMember("PrivateField")) 'Private member in Private Type CheckMethods(sourceType.GetMember("FriendMethod"), retargetingType.GetMember("FriendMethod")) 'Friend member in Private Type 'Friend Interface Type with no accessors sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestInterface") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestInterface") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMember("Sub_In_Interface"), retargetingType.GetMember("Sub_In_Interface")) CheckMethods(sourceType.GetMember("Function_In_Interface"), retargetingType.GetMember("Function_In_Interface")) 'Diagnostics should be the same in Retargeting or Non-Retargeting scenarios as they are these are handled in 'semantic behavior and symbols need to be available for this to occur irrespective of scope. 'Expect same diagnostic errors with retargeting main_NoRetarget.VerifyDiagnostics(Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestStructure").WithArguments("TestStructure", "Friend")) '//Retargetted - should result in No Errors also and same runtime behavior Main_Retarget.VerifyDiagnostics(Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestInterface").WithArguments("TestInterface", "Friend"), Diagnostic(ERRID.ERR_InaccessibleSymbol2, "TestStructure").WithArguments("TestStructure", "Friend")) End Sub <Fact> Public Sub Retarget_Array_Types() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Module Module1a Sub Main() ReDim Module1.Array_Test_Class(10) ReDim Module1.Array_Test_Structure(11) ReDim Module1.Array_Test_Class_Jagged(12) ReDim Module1.Array_Test_Structure_Jagged(13) ReDim Module1.Array_Test_Class_Multi(10, 20) ReDim Module1.Array_Test_Structure_Multi(11, 21, 31) 'This will be using types which are array types Dim Usage_Local_1 = Module1.Array_Test_Class Dim Usage_Local_2 = Module1.Array_Test_Structure Dim Usage_Local_3 = Module1.Array_Test_Class_Jagged Dim Usage_Local_4 = Module1.Array_Test_Structure_Jagged Dim Usage_Local_5 = Module1.Array_Test_Class_Multi Dim Usage_Local_6 = Module1.Array_Test_Structure_Multi 'Use the Local types Console.WriteLine(Usage_Local_1.GetLength(0)) Console.WriteLine(Usage_Local_2.GetLength(0)) Console.WriteLine(Usage_Local_3.GetLength(0)) Console.WriteLine(Usage_Local_4.GetLength(0)) Console.WriteLine(Usage_Local_5.GetLength(0)) Console.WriteLine(Usage_Local_5.GetLength(1)) Console.WriteLine(Usage_Local_6.GetLength(0)) Console.WriteLine(Usage_Local_6.GetLength(1)) Console.WriteLine(Usage_Local_6.GetLength(2)) End Sub End Module ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Imports System Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Public Structure TestStructure Public _int_In_Structure As Integer Public Property String_Property As String End Structure Public Class TestAttribute Inherits Attribute End Class Public Module Module1 'These are array types Public Array_Test_Class() As TestClass Public Array_Test_Structure As TestStructure() Public Array_Test_Class_Jagged()() As TestClass Public Array_Test_Structure_Jagged()() As TestStructure Public Array_Test_Class_Multi(,) As TestClass Public Array_Test_Structure_Multi(,,) As TestStructure End Module ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[11 12 13 14 11 21 12 22 32]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also and same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[11 12 13 14 11 21 12 22 32]]>) Main_Retarget.VerifyDiagnostics() 'Check the retargeting symbol information Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace = SourceModuleReference.GlobalNamespace Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace = retargetingModule.GlobalNamespace 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMethod(".ctor"), retargetingType.GetMethod(".ctor")) CheckFields(sourceType.GetMember("_Field"), retargetingType.GetMember("_Field")) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) CheckProperties(sourceType.GetMember("ReadOnlyProperty"), retargetingType.GetMember("ReadOnlyProperty")) CheckProperties(sourceType.GetMember("WriteOnlyProperty"), retargetingType.GetMember("WriteOnlyProperty")) 'Structure sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestStructure") CheckTypes(sourceType, retargetingType) CheckFields(sourceType.GetMember("_int_In_Structure"), retargetingType.GetMember("_int_In_Structure")) CheckProperties(sourceType.GetMember("String_Property"), retargetingType.GetMember("String_Property")) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Module1") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Module1") CheckTypes(sourceType, retargetingType) 'Fields of various types Array types 'Verify the retargeting fields and that they are array types 'Single, Jagged and Multi Dimensional CheckFields(sourceType.GetMember("Array_Test_Class"), retargetingType.GetMember("Array_Test_Class")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Class"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Class"), RetargetingFieldSymbol).UnderlyingField.Type)) CheckFields(sourceType.GetMember("Array_Test_Structure"), retargetingType.GetMember("Array_Test_Structure")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Structure"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Class"), RetargetingFieldSymbol).UnderlyingField.Type)) CheckFields(sourceType.GetMember("Array_Test_Class_Jagged"), retargetingType.GetMember("Array_Test_Class_Jagged")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Class_Jagged"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Class_Jagged"), RetargetingFieldSymbol).UnderlyingField.Type)) CheckFields(sourceType.GetMember("Array_Test_Structure_Jagged"), retargetingType.GetMember("Array_Test_Structure_Jagged")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Structure_Jagged"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Structure_Jagged"), RetargetingFieldSymbol).UnderlyingField.Type)) CheckFields(sourceType.GetMember("Array_Test_Class_Multi"), retargetingType.GetMember("Array_Test_Class_Multi")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Class_Multi"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Class_Multi"), RetargetingFieldSymbol).UnderlyingField.Type)) CheckFields(sourceType.GetMember("Array_Test_Structure_Multi"), retargetingType.GetMember("Array_Test_Structure_Multi")) Assert.True(IsArrayType(CType(sourceType.GetMember("Array_Test_Structure_Multi"), SourceMemberFieldSymbol).Type)) Assert.True(IsArrayType(CType(retargetingType.GetMember("Array_Test_Structure_Multi"), RetargetingFieldSymbol).UnderlyingField.Type)) End Sub Friend Function IsArrayType(t As TypeSymbol) As Boolean Dim RetValue As Boolean = False Try If t.IsArrayType Then RetValue = True Catch End Try Return RetValue End Function <Fact> Public Sub Retarget_Overloads_overrides_Shadows() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Module Module1 Sub Main() Dim Usage_1 As New Usage_C1 Dim Usage2 As New TestClass_NotInheriTABLE 'Shared Dim Usage3 As New TestClass_Shared TestClass_Shared._Field = "Success" TestClass_Shared.TestProperty = 1 TestClass_Shared.SharedMethods() Dim Usage4 As New TestClass_Other Usage4.TestProperty = 2 Usage4.Method() Usage4.MethodOverload(1) Dim Usage4_Base As New TestClass_Base Usage4_Base.TestProperty = 3 Usage4_Base.Method() Usage4_Base.MethodOverload() End Sub Class Usage_C1 Inherits TestClass_MustInherit End Class #If CompileError Then Class Usage_C1_error Inherits TestClass_NotInheriTABLE End Class #End If End Module ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Imports System Public MustInherit Class TestClass_MustInherit Public Property TestProperty As Integer Public _Field As String = "" End Class Public NotInheritable Class TestClass_NotInheriTABLE Public Property TestProperty As Integer Public _Field As String = "" End Class Public Class TestClass_Shared Public Shared Property TestProperty As Integer Public Shared _Field As String = "" Public Shared Sub SharedMethods() Console.WriteLine("Sharedmethod") End Sub End Class Public Class TestClass_Base Public Property TestProperty As Integer Public Overridable Sub Method() Console.WriteLine("Method(Base)") End Sub Public Sub MethodOverload() Console.WriteLine("MethodOverload(Base)") End Sub End Class Public Class TestClass_Other Inherits TestClass_Base Public Shadows Property TestProperty As Integer Public Overrides Sub method() Console.WriteLine("method(Other)") End Sub Public Overloads Sub MethodOverload(x As Integer) Console.WriteLine("MethodOverload(Other)") End Sub End Class ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[Sharedmethod method(Other) MethodOverload(Other) Method(Base) MethodOverload(Base) ]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[Sharedmethod method(Other) MethodOverload(Other) Method(Base) MethodOverload(Base) ]]>) Main_Retarget.VerifyDiagnostics() 'Check Retargeting Symbols Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace = SourceModuleReference.GlobalNamespace Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace = retargetingModule.GlobalNamespace Dim sourceType As NamedTypeSymbol Dim retargetingType As NamedTypeSymbol sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass_MustInherit") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass_MustInherit") CheckTypes(sourceType, retargetingType) CheckFields(sourceType.GetMember("_Field"), retargetingType.GetMember("_Field")) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) Assert.True(sourceType.IsMustInherit) Assert.Equal(sourceType.IsMustInherit, retargetingType.IsMustInherit) 'NotInheritable sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass_NotInheriTABLE") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass_NotInheriTABLE") CheckTypes(sourceType, retargetingType) Assert.True(sourceType.IsNotInheritable) Assert.Equal(sourceType.IsNotInheritable, retargetingType.IsNotInheritable) 'Shared sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Shared") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Shared") CheckTypes(sourceType, retargetingType) CheckMethods(sourceType.GetMember("SharedMethods"), retargetingType.GetMember("SharedMethods")) Assert.True(sourceType.GetMember("SharedMethods").IsShared) Assert.Equal(sourceType.GetMember("SharedMethods").IsShared, retargetingType.GetMember("SharedMethods").IsShared) CheckFields(sourceType.GetMember("_Field"), retargetingType.GetMember("_Field")) Assert.True(sourceType.GetMember("_Field").IsShared) Assert.Equal(sourceType.GetMember("_Field").IsShared, retargetingType.GetMember("_Field").IsShared) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) Assert.True(sourceType.GetMember("TestProperty").IsShared) Assert.Equal(sourceType.GetMember("TestProperty").IsShared, retargetingType.GetMember("TestProperty").IsShared) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Base") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Base") CheckTypes(sourceType, retargetingType) Assert.True(sourceType.GetMember("Method").IsOverridable) Assert.Equal(sourceType.GetMember("Method").IsOverridable, retargetingType.GetMember("Method").IsOverridable) CheckMethods(sourceType.GetMember("Method"), retargetingType.GetMember("Method")) Assert.True(sourceType.GetMember("MethodOverload").IsOverloadable) Assert.Equal(sourceType.GetMember("MethodOverload").IsOverloadable, retargetingType.GetMember("MethodOverload").IsOverloadable) CheckMethods(sourceType.GetMember("MethodOverload"), retargetingType.GetMember("MethodOverload")) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Other") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("TestClass_Other") CheckTypes(sourceType, retargetingType) Assert.False(sourceType.GetMember("Method").IsOverridable) Assert.Equal(sourceType.GetMember("Method").IsOverridable, retargetingType.GetMember("Method").IsOverridable) Assert.Equal(sourceType.GetMember("Method").IsOverrides, retargetingType.GetMember("Method").IsOverrides) CheckMethods(sourceType.GetMember("Method"), retargetingType.GetMember("Method")) Assert.False(sourceType.GetMember("MethodOverload").IsOverridable) Assert.Equal(sourceType.GetMember("MethodOverload").IsOverridable, retargetingType.GetMember("MethodOverload").IsOverridable) Assert.True(sourceType.GetMember("MethodOverload").IsOverloadable) Assert.Equal(sourceType.GetMember("MethodOverload").IsOverloadable, retargetingType.GetMember("MethodOverload").IsOverloadable) Assert.Equal(sourceType.GetMember("MethodOverload").IsOverloads, retargetingType.GetMember("MethodOverload").IsOverloads) CheckMethods(sourceType.GetMember("MethodOverload"), retargetingType.GetMember("MethodOverload")) CheckProperties(sourceType.GetMember("TestProperty"), retargetingType.GetMember("TestProperty")) Assert.True(sourceType.GetMember("TestProperty").IsShadows) 'Check Assert.True(sourceType.GetMember("TestProperty").ShadowsExplicitly) Assert.False(retargetingType.GetMember("TestProperty").ShadowsExplicitly) Assert.True(CType(retargetingType.GetMember("TestProperty"), RetargetingPropertySymbol).UnderlyingProperty.ShadowsExplicitly) End Sub <Fact(Skip:="https://github.com/dotnet/roslyn/issues/79350")> Public Sub Retarget_Events() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Public Module Module1 WithEvents x As New EventClass Dim noevents As New EventClass Dim StrResult = "" Sub Main() StrResult = "" Module_TestEventsWithHandlers.Caller_RaiseTestEvents() If Module_TestEventsWithHandlers.EventCalled = "CalledCalled" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If StrResult = "" Module_TestEventsWithAddHandler.Caller_RaiseTestEvents() If Module_TestEventsWithAddHandler.EventCalled = "Called" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If 'Using Withevents - events may be raised by no handlers hooked up StrResult = "" Module_TestEventsWithAddHandler.EventCalled = "" If Module_TestEventsWithHandlers.EventCalled = "CalledCalled" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If x.RaiseEvents() If StrResult = "Called c" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If AddHandler x.XEvent, AddressOf a AddHandler x.YEvent, AddressOf b x.RaiseEvents() If StrResult = "Called cCalled cCalled aCalled b" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If 'Using Class StrResult = "" Dim U1 As New EventClass AddHandler U1.XEvent, AddressOf a RemoveHandler U1.XEvent, AddressOf a AddHandler U1.YEvent, AddressOf a U1.RaiseEvents() ' This will call method which will raise events If StrResult = "Called a" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If StrResult = "" x.RaiseEvents() StrResult = "" noevents.RaiseEvents() If StrResult = "" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If StrResult = "" AddHandler noevents.XEvent, AddressOf b RemoveHandler noevents.XEvent, AddressOf b AddHandler noevents.YEvent, AddressOf b noevents.RaiseEvents() If StrResult = "Called b" Then Console.WriteLine("Success") Else Console.WriteLine("Fail") End If End Sub Private Sub a() StrResult &= "Called a" End Sub Private Sub b() StrResult &= "Called b" End Sub Private Sub c() Handles x.XEvent StrResult &= "Called c" End Sub End Module ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ ' Declare a WithEvents variable. Public Module Module_TestEventsWithHandlers Public Property EventCalled As String = "" Dim WithEvents EClass As New EventClass ' Call the method that raises the object's events. Sub Caller_RaiseTestEvents() EventCalled = "" EClass.RaiseEvents() End Sub ' Declare an event handler that handles multiple events. Sub EClass_EventHandler() Handles EClass.XEvent, EClass.YEvent EventCalled &= "Called" End Sub End Module ' Declare a WithEvents variable. Public Module Module_TestEventsWithAddHandler Public Property EventCalled As String = "" Dim WithEvents EClass As New EventClass ' Call the method that raises the object's events. Sub Caller_RaiseTestEvents() AddHandler EClass.XEvent, AddressOf EClass_EventHandler AddHandler EClass.YEvent, AddressOf EClass_EventHandler RemoveHandler EClass.YEvent, AddressOf EClass_EventHandler EClass.RaiseEvents() End Sub ' Declare an event handler that handles multiple events. Sub EClass_EventHandler() EventCalled &= "Called" End Sub End Module Public Class EventClass Public Event XEvent() Public Event YEvent() ' RaiseEvents raises both events. Public Sub RaiseEvents() RaiseEvent XEvent() RaiseEvent YEvent() End Sub End Class ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[Success Success Success Success Success Success Success Success]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also and same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[Success Success Success Success Success Success Success Success]]>) Main_Retarget.VerifyDiagnostics() 'Check the retargeting symbol information Dim sourceAssembly As SourceAssemblySymbol = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference As ModuleSymbol = sourceAssembly.Modules(0) Dim sourceNamespace = SourceModuleReference.GlobalNamespace Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace = retargetingModule.GlobalNamespace 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("EventClass") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("EventClass") CheckTypes(sourceType, retargetingType) CheckTypes(CType(sourceType.GetMember("xEvent"), SourceEventSymbol).Type, CType(retargetingType.GetMember("xEvent"), RetargetingEventSymbol).Type) CheckEvent(sourceType.GetMember("xEvent"), retargetingType.GetMember("xEvent")) CheckEvent(sourceType.GetMember("yEvent"), retargetingType.GetMember("yEvent")) Dim SourceEventItem = CType(retargetingType.GetMember("xEvent"), EventSymbol) Dim RetargetEventItem = CType(retargetingType.GetMember("xEvent"), RetargetingEventSymbol).UnderlyingEvent Assert.NotNull(RetargetEventItem.AddMethod) Assert.NotNull(RetargetEventItem.RemoveMethod) Assert.Null(RetargetEventItem.RaiseMethod) Assert.Null(SourceEventItem.RaiseMethod) Assert.Equal(SymbolKind.Event, RetargetEventItem.Kind) Assert.Equal(SourceEventItem.AddMethod.Name, RetargetEventItem.AddMethod.Name) Assert.Equal(SourceEventItem.RemoveMethod.Name, RetargetEventItem.RemoveMethod.Name) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Module_TestEventsWithAddHandler") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Module_TestEventsWithAddHandler") CheckTypes(sourceType, retargetingType) CheckProperties(sourceType.GetMember("EClass"), retargetingType.GetMember("EClass")) CheckFields(sourceType.GetMember("_EClass"), retargetingType.GetMember("_EClass")) Assert.True(sourceType.GetMember("EClass").IsWithEventsProperty) Assert.Equal(sourceType.GetMember("EClass").IsWithEventsProperty, retargetingType.GetMember("EClass").IsWithEventsProperty) End Sub <Fact> Public Sub Retarget_Attributes() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Module Module1 Sub Main() Dim x0 As New UsageClass Dim x1 As New UsageClass_1 Dim x2 As New UsageClass_2 Usage_All.Prop1 = 1 Usage_All._Field = "test" Usage_All.Method1() Usage_All.Prop1 = Test.Item End Sub End Module 'Attribute Usage Class or Structure <ClassOrStructureAttribute()> <Attribute_Class> Class UsageClass End Class <ClassOrStructureAttribute()> Structure UsageStructure End Structure 'Multiple Attributes <Attribute_All, Attribute_Class> Class UsageClass_1 End Class <Attribute_All, Attribute_Class> <ClassOrStructure> Class UsageClass_2 End Class <Attribute_All> Module Usage_All <Attribute_All> Property Prop1 As Integer <Attribute_All> Public _Field As String = "" <Attribute_All> Sub Method1() Console.WriteLine(Prop1.ToString) Console.WriteLine(_Field) End Sub End Module <Attribute_InheritedFalse> Class InheritedFalse End Class <Attribute_Enum> Public Enum Test Item Item2 End Enum ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Imports System <AttributeUsage(AttributeTargets.Class, AllowMultiple:=False)> _ Public Class Attribute_Class Inherits Attribute End Class <AttributeUsage(AttributeTargets.Method, Inherited:=True, AllowMultiple:=False)> _ Public Class Attribute_method Inherits Attribute End Class <AttributeUsage(AttributeTargets.All, Inherited:=True, AllowMultiple:=False)> _ Public Class Attribute_All Inherits Attribute End Class <AttributeUsage(AttributeTargets.Enum, Inherited:=True, AllowMultiple:=False)> _ Public Class Attribute_Enum Inherits Attribute End Class <AttributeUsage(AttributeTargets.All, Inherited:=False, AllowMultiple:=True)> _ Public Class Attribute_InheritedFalse Inherits Attribute End Class <AttributeUsage(AttributeTargets.Class Or AttributeTargets.Struct)> Public Class ClassOrStructureAttribute Inherits Attribute End Class <AttributeUsage(AttributeTargets.Class)><Attribute_Class> Public Class Class_Multiple Inherits Attribute End Class ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[1 test ]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[1 test ]]>) Main_Retarget.VerifyDiagnostics() Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace = SourceModuleReference.GlobalNamespace Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace = retargetingModule.GlobalNamespace 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing ''Check Attributes sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Attribute_Class") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Attribute_Class") CheckTypes(sourceType, retargetingType) Assert.Equal(1, retargetingType.GetAttributes.Length) Assert.Equal(sourceType.GetAttributes.Length, retargetingType.GetAttributes.Length) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Attribute_method") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Attribute_method") Assert.Equal(1, retargetingType.GetAttributes.Length) Assert.Equal(sourceType.GetAttributes.Length, retargetingType.GetAttributes.Length) CheckTypes(sourceType, retargetingType) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("ClassOrStructureAttribute") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("ClassOrStructureAttribute") Assert.Equal(1, retargetingType.GetAttributes.Length) Assert.Equal(sourceType.GetAttributes.Length, retargetingType.GetAttributes.Length) CheckTypes(sourceType, retargetingType) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Class_Multiple") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Class_Multiple") Assert.Equal(2, retargetingType.GetAttributes.Length) Assert.Equal(sourceType.GetAttributes.Length, retargetingType.GetAttributes.Length) CheckTypes(sourceType, retargetingType) End Sub <Fact> Public Sub RetargetTest_NoChangeInDiagnostics_CleanCompile() 'This test should also result in clean compilation after retargeting Dim sourceLibV1 = <compilation name="Lib"> <file><![CDATA[ Imports System Namespace ClassLibrary1 Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Public Structure TestStructure Dim _int_In_Structure As Integer Public Property String_Property As String End Structure Public Interface TestInterface Sub Sub_In_Interface(y As String) Function Function_In_Interface(x As Integer) As Boolean End Interface Public Class TestAttribute Inherits Attribute End Class <Test> Public Class Class_With_Attribute End Class <Test> Public Structure Structure_With_Attribute Dim int_In_Structure As Integer End Structure 'Test Enum Public Enum Test_Enum Item1 Item3 = 3 End Enum Public Module Test_Module Public Const Test_Constant As Integer = 101 Public Delegate Sub DelSub(x As Integer) Public Delegate Function DelFunction(x As String) As Boolean End Module 'Generic Types Public Class Generic_Test_Class(Of t) Public Function xyz() As Integer Return True End Function End Class 'Constrained Public Class Generic_Test_Class_Constrained_Specific(Of t As TestClass) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Interface(Of t As TestInterface) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_New(Of t As New) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Multiple(Of t As {New, TestClass}) Public Function xyz() As Integer Return True End Function End Class Public Class NestedTypeBase End Class Public Class NestedTypeDerived Inherits NestedTypeBase End Class Namespace TestNS Public Class Class_In_NS Public Property SuccessProperty As Boolean = True End Class End Namespace End Namespace ]]> </file> </compilation> Dim sourceMain = <compilation name="Main"> <file><![CDATA[ Imports System Imports ClassLibrary1.TestNS Module Module1 Sub Main() Dim Usage_Class As New NewClass Usage_Class.TestProperty = 101 With Usage_Class ._Field = 102 If .ReadOnlyProperty <> 102 Then Console.WriteLine("Problem") End If .WriteOnlyProperty = 103 If .ReadOnlyProperty <> 103 Then Console.WriteLine("Problem") End If End With End Sub End Module 'We need to use each of the items in the Class Library Class NewClass Inherits ClassLibrary1.TestClass End Class <ClassLibrary1.Test> Class NewClass_Using_Attribute End Class Class NewClass_ImplementingInterface Implements ClassLibrary1.TestInterface Public Sub Sub_In_Interface(y As String) Implements ClassLibrary1.TestInterface.Sub_In_Interface End Sub Public Function Function_In_Interface(x As Integer) As Boolean Implements ClassLibrary1.TestInterface.Function_In_Interface Return True End Function End Class Class New_InheritedAttribute Inherits ClassLibrary1.TestAttribute End Class Module Module_Usage Sub TestMethod() Dim x As New ClassLibrary1.Class_With_Attribute 'Structure Dim y As New ClassLibrary1.TestStructure y._int_In_Structure = 102 If y._int_In_Structure <> 102 Then Console.WriteLine("Problem") End If y.String_Property = "Success" Console.WriteLine("Property:" & y.String_Property) End Sub Sub test_Constraints() Dim t1 As New ClassLibrary1.Generic_Test_Class(Of NewClass) Dim t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of ClassLibrary1.TestInterface) Dim t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of NewClass) Dim t3_1 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.Generic_Test_Class(Of Integer)) Dim t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of ClassLibrary1.TestClass) Dim t4_1 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of NewClass) Dim t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ClassLibrary1.TestClass) #If CompErrorTest Then Dim f_t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of NewClass) Dim f_t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.TestInterface) Dim f_t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of Integer) Dim f_t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ABC) #End If End Sub Sub Usage_Attribute() Dim x As ClassLibrary1.Structure_With_Attribute x.int_In_Structure = 1 End Sub Sub TestEnum() Dim EnumValue = ClassLibrary1.Test_Enum.Item1 EnumValue = ClassLibrary1.Test_Enum.Item3 If ClassLibrary1.Test_Module.Test_Constant <> 101 Then Console.WriteLine("Problem") End If Dim DelSub As ClassLibrary1.Test_Module.DelSub = AddressOf DelTestMethod DelSub.Invoke(1) Dim DelFunc As ClassLibrary1.Test_Module.DelFunction = AddressOf DelTestMethod Dim xresult = DelFunc("Test") End Sub Sub DelTestMethod(x As Integer) Console.WriteLine("Success") End Sub Function DelTestMethod(x As String) As Boolean If x = "Test" Then Return True Else Return False End If End Function Sub NestedTypes() Dim xb As New ClassLibrary1.NestedTypeBase Dim xd As New ClassLibrary1.NestedTypeDerived If TypeOf (xd) Is ClassLibrary1.NestedTypeDerived Then Console.WriteLine("Success") End If End Sub Sub TestNs() Dim x As New Class_In_NS If x.SuccessProperty = True Then Console.WriteLine("Success") End If End Sub End Module Class ABC End Class ]]> </file> </compilation> ''//All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(sourceLibV1, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim main_NoRetarget = CompileAndVerify(sourceMain, references:={referenceLibrary_Compilation.ToMetadataReference}) main_NoRetarget.VerifyDiagnostics() ''//Retargetted - should result in No Errors also Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(sourceMain, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify) main_NoRetarget.VerifyDiagnostics() End Sub <Fact> Public Sub RetargetTest_NoChangeInDiagnostics_Errors() ' Ensure that same errors occur in retargeting for constraint compilation errors Dim sourceLibV1 = <compilation name="Lib"> <file><![CDATA[ Imports System Namespace ClassLibrary1 Public Class TestClass 'This Class has Properties and Fields of various types etc which 'should be accessible from outside Public Property TestProperty As Integer Public ReadOnly Property ReadOnlyProperty As String Get Return _Field End Get End Property Public WriteOnly Property WriteOnlyProperty As String Set(value As String) _Field = value End Set End Property Public _Field As String = "" End Class Public Structure TestStructure Dim _int_In_Structure As Integer Public Property String_Property As String End Structure Public Interface TestInterface Sub Sub_In_Interface(y As String) Function Function_In_Interface(x As Integer) As Boolean End Interface Public Class TestAttribute Inherits Attribute End Class <Test> Public Class Class_With_Attribute End Class <Test> Public Structure Structure_With_Attribute Dim int_In_Structure As Integer End Structure 'Test Enum Public Enum Test_Enum Item1 Item3 = 3 End Enum Public Module Test_Module Public Const Test_Constant As Integer = 101 Public Delegate Sub DelSub(x As Integer) Public Delegate Function DelFunction(x As String) As Boolean End Module 'Generic Types Public Class Generic_Test_Class(Of t) Public Function xyz() As Integer Return True End Function End Class 'Constrained Public Class Generic_Test_Class_Constrained_Specific(Of t As TestClass) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Interface(Of t As TestInterface) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_New(Of t As New) Public Function xyz() As Integer Return True End Function End Class Public Class Generic_Test_Class_Constrained_Multiple(Of t As {New, TestClass}) Public Function xyz() As Integer Return True End Function End Class Public Class NestedTypeBase End Class Public Class NestedTypeDerived Inherits NestedTypeBase End Class Namespace TestNS Public Class Class_In_NS Public Property SuccessProperty As Boolean = True End Class End Namespace End Namespace ]]> </file> </compilation> Dim sourceMain = <compilation name="Main"> <file><![CDATA[ Imports System Imports ClassLibrary1 Imports ClassLibrary1.TestNS #Const CompErrorTest = True Module Module1 Sub Main() Dim Usage_Class As New NewClass Usage_Class.TestProperty = 101 With Usage_Class ._Field = 102 If .ReadOnlyProperty <> 102 Then Console.WriteLine("Problem") End If .WriteOnlyProperty = 103 If .ReadOnlyProperty <> 103 Then Console.WriteLine("Problem") End If End With End Sub End Module 'We need to use each of the items in the Class Library Class NewClass Inherits ClassLibrary1.TestClass End Class <ClassLibrary1.Test> Class NewClass_Using_Attribute End Class Class NewClass_ImplementingInterface Implements ClassLibrary1.TestInterface Public Sub Sub_In_Interface(y As String) Implements ClassLibrary1.TestInterface.Sub_In_Interface End Sub Public Function Function_In_Interface(x As Integer) As Boolean Implements ClassLibrary1.TestInterface.Function_In_Interface Return True End Function End Class Class New_InheritedAttribute Inherits ClassLibrary1.TestAttribute End Class Module Module_Usage Sub TestMethod() Dim x As New ClassLibrary1.Class_With_Attribute 'Structure Dim y As New ClassLibrary1.TestStructure y._int_In_Structure = 102 If y._int_In_Structure <> 102 Then Console.WriteLine("Problem") End If y.String_Property = "Success" Console.WriteLine("Property:" & y.String_Property) End Sub Sub test_Constraints() Dim t1 As New ClassLibrary1.Generic_Test_Class(Of NewClass) Dim t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of ClassLibrary1.TestInterface) Dim t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of NewClass) Dim t3_1 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.Generic_Test_Class(Of Integer)) Dim t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of ClassLibrary1.TestClass) Dim t4_1 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of NewClass) Dim t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ClassLibrary1.TestClass) #If CompErrorTest Then Dim f_t2 As New ClassLibrary1.Generic_Test_Class_Constrained_Interface(Of NewClass) Dim f_t3 As New ClassLibrary1.Generic_Test_Class_Constrained_New(Of ClassLibrary1.TestInterface) Dim f_t4 As New ClassLibrary1.Generic_Test_Class_Constrained_Specific(Of Integer) Dim f_t5 As New ClassLibrary1.Generic_Test_Class_Constrained_Multiple(Of ABC) #End If End Sub Sub Usage_Attribute() Dim x As ClassLibrary1.Structure_With_Attribute x.int_In_Structure = 1 End Sub Sub TestEnum() Dim EnumValue = ClassLibrary1.Test_Enum.Item1 EnumValue = ClassLibrary1.Test_Enum.Item3 If ClassLibrary1.Test_Module.Test_Constant <> 101 Then Console.WriteLine("Problem") End If Dim DelSub As ClassLibrary1.Test_Module.DelSub = AddressOf DelTestMethod DelSub.Invoke(1) Dim DelFunc As ClassLibrary1.Test_Module.DelFunction = AddressOf DelTestMethod Dim xresult = DelFunc("Test") End Sub Sub DelTestMethod(x As Integer) Console.WriteLine("Success") End Sub Function DelTestMethod(x As String) As Boolean If x = "Test" Then Return True Else Return False End If End Function Sub NestedTypes() Dim xb As New ClassLibrary1.NestedTypeBase Dim xd As New ClassLibrary1.NestedTypeDerived If TypeOf (xd) Is ClassLibrary1.NestedTypeDerived Then Console.WriteLine("Success") End If End Sub Sub TestNs() Dim x As New Class_In_NS If x.SuccessProperty = True Then Console.WriteLine("Success") End If End Sub End Module Class ABC End Class ]]> </file> </compilation> ''//All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(sourceLibV1, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim main_NoRetarget = CreateCompilationWithMscorlib40AndVBRuntimeAndReferences(sourceMain, references:={referenceLibrary_Compilation.ToMetadataReference}) main_NoRetarget.VerifyDiagnostics(Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "NewClass").WithArguments("NewClass", "ClassLibrary1.TestInterface"), Diagnostic(ERRID.ERR_NoSuitableNewForNewConstraint2, "ClassLibrary1.TestInterface").WithArguments("ClassLibrary1.TestInterface", "t"), Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "Integer").WithArguments("Integer", "ClassLibrary1.TestClass"), Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "ABC").WithArguments("ABC", "ClassLibrary1.TestClass")) ''//Retargetted - should result in Same Errors Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) Dim Main_Retarget = CreateCompilationWithMscorlib40AndVBRuntimeAndReferences(sourceMain, references:={RetargetReference}, options:=TestOptions.ReleaseExe) main_NoRetarget.VerifyDiagnostics(Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "NewClass").WithArguments("NewClass", "ClassLibrary1.TestInterface"), Diagnostic(ERRID.ERR_NoSuitableNewForNewConstraint2, "ClassLibrary1.TestInterface").WithArguments("ClassLibrary1.TestInterface", "t"), Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "Integer").WithArguments("Integer", "ClassLibrary1.TestClass"), Diagnostic(ERRID.ERR_GenericConstraintNotSatisfied2, "ABC").WithArguments("ABC", "ClassLibrary1.TestClass")) End Sub <Fact> Public Sub Retarget_Delegate() 'The test involves compilation with/without retargeting and ensuring same behavior at runtime 'same diagnostics (or lack off) as compile time 'and verification of the retargeted types and the underlying source type and pertinent items Dim source = <compilation name="App1"> <file name="a.vb"><![CDATA[ Imports System Module Module1 Sub Main() Dim D1 As ClassLibrary1.Del_NG_Sub = AddressOf s_d1 Dim D2 As ClassLibrary1.Del_NG_Function = AddressOf s_d2 Dim D3 As ClassLibrary1.Del_G_Sub(Of Integer) = AddressOf s_d3 Dim D4 As ClassLibrary1.Del_G_Function(Of Boolean) = AddressOf s_d4 Dim D5 As ClassLibrary1.Del_G_Sub_2(Of Integer) = AddressOf s_d3 Dim D6 As ClassLibrary1.Del_G_Function_2(Of Boolean) = AddressOf s_d4 'Dim d7 As ClassLibrary1.Del_G_Sub_Constraint(Of Integer) Dim d7_1 As ClassLibrary1.Del_G_Sub_Constraint(Of ClassLibrary1.Ifoo) = Nothing Console.WriteLine("Success") End Sub Private Sub s_d1() Console.WriteLine("s_d1") End Sub Private Function s_d2() As Integer Console.WriteLine("s_d2") Return 1 End Function Private Sub s_d3() Console.WriteLine("s_d3") End Sub Private Function s_d4() Console.WriteLine("s_d4") Return 1 End Function Private Sub s_d5(x As Integer) Console.WriteLine("s_d5") End Sub Private Function s_d6(y As Integer) As Integer Console.WriteLine("s_d6") Return 1 End Function Class Goo End Class End Module ]]> </file> </compilation> Dim CL1_source = <compilation name="C1"> <file name="Cl.vb"><![CDATA[ Namespace ClassLibrary1 Public Module Module1 Public Delegate Sub Del_NG_Sub() Public Delegate Function Del_NG_Function() As Integer Public Delegate Sub Del_G_Sub(Of t)() Public Delegate Function Del_G_Function(Of t)() As t Public Delegate Sub Del_G_Sub_2(Of t)(x As t) Public Delegate Function Del_G_Function_2(Of t)(x As t) As t Public Delegate Sub Del_G_Sub_Constraint(Of t As Ifoo)(x As t) End Module Public Interface Ifoo End Interface End Namespace ]]> </file> </compilation> 'Check Expected Behavior - Expect no diagnostic errors with retargeting ' All on same FX - should result in No Errors Dim referenceLibrary_Compilation = DirectCast(CompileAndVerify(CL1_source, options:=TestOptions.ReleaseDll).Compilation, VisualBasicCompilation) Dim referenceLibrary_Metadata = referenceLibrary_Compilation.ToMetadataReference Dim main_NoRetarget = CompileAndVerify(source, references:={referenceLibrary_Metadata}, expectedOutput:=<![CDATA[Success ]]>) main_NoRetarget.VerifyDiagnostics() '//Retargetted - should result in No Errors also and same runtime behavior Dim RetargetReference = RetargetCompilationToV2MsCorlib(referenceLibrary_Compilation) ' ILVerify: Multiple modules named 'mscorlib' were found Dim Main_Retarget = CompileAndVerify(source, references:={RetargetReference}, options:=TestOptions.ReleaseExe, verify:=Verification.FailsILVerify, expectedOutput:=<![CDATA[Success ]]>) Main_Retarget.VerifyDiagnostics() 'Check the retargeting symbol information Dim sourceAssembly = DirectCast(RetargetReference.Compilation.Assembly, SourceAssemblySymbol) Dim SourceModuleReference = sourceAssembly.Modules(0) Dim sourceNamespace As SourceNamespaceSymbol = CType(SourceModuleReference.GlobalNamespace.GetNamespace("ClassLibrary1"), SourceNamespaceSymbol) Dim retargetingAssembly = Main_Retarget.Compilation.GetReferencedAssemblySymbol(RetargetReference) Dim retargetingModule = retargetingAssembly.Modules(0) Dim retargetingNamespace As RetargetingNamespaceSymbol = CType(retargetingModule.GlobalNamespace.GetNamespace("ClassLibrary1"), RetargetingNamespaceSymbol) 'Comparison of Types Dim sourceType As NamedTypeSymbol = Nothing Dim retargetingType As NamedTypeSymbol = Nothing 'Lets Look at the Delegate Items sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Module1") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Module1") CheckTypes(sourceType, retargetingType) sourceType = sourceNamespace.GetMember(Of NamedTypeSymbol)("Module1") retargetingType = retargetingNamespace.GetMember(Of NamedTypeSymbol)("Module1") CheckTypes(sourceType, retargetingType) CheckTypes(sourceType.GetMember("Del_NG_Sub"), retargetingType.GetMember("Del_NG_Sub")) CheckTypes(sourceType.GetMember("Del_NG_Function"), retargetingType.GetMember("Del_NG_Function")) CheckTypes(sourceType.GetMember("Del_G_Sub"), retargetingType.GetMember("Del_G_Sub")) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Sub"), SourceNamedTypeSymbol).TypeParameters.Length) CheckTypeParameters(CType(sourceType.GetMember("Del_G_Sub"), SourceNamedTypeSymbol).TypeParameters(0), CType(retargetingType.GetMember("Del_G_Sub"), RetargetingNamedTypeSymbol).TypeParameters(0)) CheckTypes(sourceType.GetMember("Del_G_Function"), retargetingType.GetMember("Del_G_Function")) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Function"), SourceNamedTypeSymbol).TypeParameters.Length) CheckTypeParameters(CType(sourceType.GetMember("Del_G_Function"), SourceNamedTypeSymbol).TypeParameters(0), CType(retargetingType.GetMember("Del_G_Function"), RetargetingNamedTypeSymbol).TypeParameters(0)) CheckTypes(sourceType.GetMember("Del_G_Sub_2"), retargetingType.GetMember("Del_G_Sub_2")) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Sub_2"), SourceNamedTypeSymbol).TypeParameters.Length) CheckTypeParameters(CType(sourceType.GetMember("Del_G_Sub_2"), SourceNamedTypeSymbol).TypeParameters(0), CType(retargetingType.GetMember("Del_G_Sub_2"), RetargetingNamedTypeSymbol).TypeParameters(0)) Assert.Equal(0, CType(sourceType.GetMember("Del_G_Sub_2"), SourceNamedTypeSymbol).TypeParameters(0).ConstraintTypes.Length) CheckTypes(sourceType.GetMember("Del_G_Function_2"), retargetingType.GetMember("Del_G_Function_2")) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Function_2"), SourceNamedTypeSymbol).TypeParameters.Length) CheckTypeParameters(CType(sourceType.GetMember("Del_G_Function_2"), SourceNamedTypeSymbol).TypeParameters(0), CType(retargetingType.GetMember("Del_G_Function_2"), RetargetingNamedTypeSymbol).TypeParameters(0)) CheckTypes(sourceType.GetMember("Del_G_Sub_Constraint"), retargetingType.GetMember("Del_G_Sub_Constraint")) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Sub_Constraint"), SourceNamedTypeSymbol).TypeParameters.Length) CheckTypeParameters(CType(sourceType.GetMember("Del_G_Sub_Constraint"), SourceNamedTypeSymbol).TypeParameters(0), CType(retargetingType.GetMember("Del_G_Sub_Constraint"), RetargetingNamedTypeSymbol).TypeParameters(0)) Assert.Equal(1, CType(sourceType.GetMember("Del_G_Sub_Constraint"), SourceNamedTypeSymbol).TypeParameters(0).ConstraintTypes.Length) Assert.Equal(CType(sourceType.GetMember("Del_G_Sub_Constraint"), SourceNamedTypeSymbol).TypeParameters(0).ConstraintTypes(0), CType(retargetingType.GetMember("Del_G_Sub_Constraint"), RetargetingNamedTypeSymbol).UnderlyingNamedType.TypeParameters(0).ConstraintTypes(0)) End Sub Friend Function RetargetCompilationToV2MsCorlib(C As VisualBasicCompilation) As VisualBasicCompilationReference Dim NewCompilation As VisualBasicCompilation = Nothing Dim OldReference As MetadataReference = Nothing Dim OldVBReference As MetadataReference = Nothing 'For Retargeting - I want to ensure that if mscorlib v4 is detected then I will retarget to V2. 'This should apply to mscorlib, microsoft.visualbasic, system 'Exist V2 reference Dim bAbleToRetargetToV2 As Boolean = False For Each r In C.References Dim Item As String = r.Display If r.Display.ToLower.Contains("mscorlib") And r.Display.ToLower.Contains("net4") Then bAbleToRetargetToV2 = True End If Next 'Verify is mscorlib reference is present that is v4 If bAbleToRetargetToV2 Then Dim AssembliesToRetarget As Integer = 0 For Each r In C.References Dim Item As String = r.Display If r.Display.ToLower.Contains("mscorlib") And r.Display.ToLower.Contains("net4") Then OldReference = r AssembliesToRetarget = AssembliesToRetarget + 1 ElseIf r.Display.ToLower.Contains("microsoft.visualbasic") And r.Display.ToLower.Contains("net4") Then OldVBReference = r AssembliesToRetarget = AssembliesToRetarget + 2 'ElseIf r.Display.Contains("System") And r.Display.Contains("v4") Then 'bfound = bfound + 4 End If Next If AssembliesToRetarget = 0 Then NewCompilation = C Else 'Retarget to use v2.0 assemblies If AssembliesToRetarget = 1 Then NewCompilation = C.ReplaceReference(oldReference:=OldReference, newReference:=Net20.References.mscorlib) ElseIf AssembliesToRetarget = 2 Then NewCompilation = C.ReplaceReference(oldReference:=OldVBReference, newReference:=Net20.References.MicrosoftVisualBasic) ElseIf AssembliesToRetarget = 3 Then NewCompilation = C.ReplaceReference(oldReference:=OldReference, newReference:=Net20.References.mscorlib). ReplaceReference(oldReference:=OldVBReference, newReference:=Net20.References.MicrosoftVisualBasic) End If End If Else NewCompilation = C End If Return New VisualBasicCompilationReference(NewCompilation) End Function <Fact> <WorkItem(703433, "http://vstfdevdiv:8080/DevDiv2/DevDiv/_workitems/edit/703433")> Public Sub Bug703433() Dim source1 = <compilation> <file name="a.vb"> Public Class C1(Of T) End Class </file> </compilation> Dim comp1 = CreateEmptyCompilationWithReferences(source1, {MscorlibRef_v20}, TestOptions.ReleaseDll) comp1.VerifyDiagnostics() Dim c1 As NamedTypeSymbol = comp1.Assembly.GlobalNamespace.GetTypeMembers("C1").Single Dim source2 = <compilation> <file name="a.vb"> </file> </compilation> Dim comp2 = CreateEmptyCompilationWithReferences(source2, {MscorlibRef_v4_0_30316_17626, New VisualBasicCompilationReference(comp1)}, TestOptions.ReleaseDll) Dim c1r As NamedTypeSymbol = comp2.GlobalNamespace.GetTypeMembers("C1").Single Assert.IsType(Of RetargetingNamedTypeSymbol)(c1r) Assert.Equal(c1.Name, c1r.Name) Assert.Equal(c1.Arity, c1r.Arity) Assert.Equal(c1.MangleName, c1r.MangleName) Assert.Equal(c1.MetadataName, c1r.MetadataName) End Sub <Fact> <WorkItem(3898, "https://github.com/dotnet/roslyn/issues/3898")> Public Sub Regargeting_IsSerializable() Dim source1 = <compilation> <file name="a.vb"><![CDATA[ Public Class C(Of T) End Class <System.Serializable> Public Class CS(Of T) End Class ]]></file> </compilation> Dim comp1 = CreateEmptyCompilation(ParseSourceXml(source1, Nothing).ToArray(), references:={MscorlibRef_v20}, options:=TestOptions.ReleaseDll) comp1.VerifyDiagnostics() Dim source2 = <compilation> <file name="a.vb"> </file> </compilation> Dim comp2 = CreateEmptyCompilation(ParseSourceXml(source2, Nothing).ToArray(), references:={MscorlibRef_v4_0_30316_17626, New VisualBasicCompilationReference(comp1)}, options:=TestOptions.ReleaseDll) Dim c As NamedTypeSymbol = comp2.GlobalNamespace.GetTypeMembers("C").Single Assert.IsType(Of RetargetingNamedTypeSymbol)(c) Assert.False(DirectCast(c, INamedTypeSymbol).IsSerializable) Dim cs As NamedTypeSymbol = comp2.GlobalNamespace.GetTypeMembers("CS").Single Assert.IsType(Of RetargetingNamedTypeSymbol)(cs) Assert.True(DirectCast(cs, INamedTypeSymbol).IsSerializable) End Sub <Fact> Public Sub ExplicitInterfaceImplementationRetargetingGenericType() Dim source1 = " Public Class C1(Of T) Public Interface I1 Sub M(x As T) End Interface End Class " Dim ref1 = CreateEmptyCompilation("").ToMetadataReference() Dim compilation1 = CreateCompilation(source1, references:={ref1}) Dim source2 = " Public Class C2(Of U) Implements C1(Of U).I1 Sub M(x As U) Implements C1(Of U).I1.M End Sub End Class " Dim compilation2 = CreateCompilation(source2, references:={compilation1.ToMetadataReference(), ref1, CreateEmptyCompilation("").ToMetadataReference()}) Dim compilation3 = CreateCompilation("", references:={compilation1.ToMetadataReference(), compilation2.ToMetadataReference()}) Assert.NotSame(compilation2.GetTypeByMetadataName("C1`1"), compilation3.GetTypeByMetadataName("C1`1")) Dim c2 = compilation3.GetTypeByMetadataName("C2`1") Assert.IsType(Of RetargetingNamedTypeSymbol)(c2) Dim m = c2.GetMethod("M") Assert.Equal(c2.Interfaces().Single().GetMethod("M"), m.ExplicitInterfaceImplementations.Single()) End Sub End Class #End If End Namespace