classdeclaration.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

' 
' Visual Basic.Net Compiler
' Copyright (C) 2004 - 2007 Rolf Bjarne Kvinge, [e-mail]
' 
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
' 
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Lesser General Public License for more details.
' 
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
' 

Imports System.Reflection
Imports System.Reflection.Emit

''' <summary>
''' ClassDeclaration  ::=
'''	[  Attributes  ]  [  ClassModifier+  ]  "Class"  Identifier  [  TypeParameters  ]  StatementTerminator
'''	[  ClassBase  ]
'''	[  TypeImplementsClause+  ]
'''	[  ClassMemberDeclaration+  ]
'''	"End" "Class" StatementTerminator
''' 
''' ClassBase ::= Inherits NonArrayTypeName StatementTerminator
''' </summary>
''' <remarks></remarks>
Public Class ClassDeclaration
    Inherits PartialTypeDeclaration
    Implements IHasImplicitMembers

    Private m_Inherits As NonArrayTypeName

    Sub New(ByVal Parent As ParsedObject, ByVal [Namespace] As String)
        MyBase.New(Parent, [Namespace])
    End Sub

    Shadows Sub Init(ByVal CustomAttributes As Attributes, ByVal Modifiers As Modifiers, ByVal DeclaringType As TypeDeclaration, ByVal Members As MemberDeclarations, ByVal Name As Token, ByVal TypeParameters As TypeParameters, ByVal [Inherits] As NonArrayTypeName, ByVal TypeImplementsClauses As TypeImplementsClauses)
        MyBase.Init(CustomAttributes, Modifiers, Members, Name, TypeParameters, TypeImplementsClauses)
        m_Inherits = [Inherits]
    End Sub

    ReadOnly Property [Inherits]() As NonArrayTypeName
        Get
            Return m_Inherits
        End Get
    End Property


    ''' <summary>
    ''' Returns the default constructor (non-private, non-shared, with no parameters) for the base type (if any). 
    ''' If no constructor found, returns nothing.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetBaseDefaultConstructor() As ConstructorInfo
        If Me.BaseType.IsGenericType Then
            Helper.Assert(Me.m_Inherits.IsConstructedTypeName)
            Return Compiler.Helper.GetDefaultGenericConstructor(Me.m_Inherits.AsConstructedTypeName)
        Else
            Return Compiler.Helper.GetDefaultConstructor(Me.BaseType)
        End If
    End Function

    Public Overrides ReadOnly Property TypeAttributes() As System.Reflection.TypeAttributes
        Get
            Dim result As TypeAttributes = MyBase.TypeAttributes

            If Me.Modifiers.Is(ModifierMasks.MustInherit) Then
                result = result Or Reflection.TypeAttributes.Abstract
            ElseIf Me.Modifiers.Is(ModifierMasks.NotInheritable) Then
                result = result Or Reflection.TypeAttributes.Sealed
            End If

            Return result
        End Get
    End Property

    Overrides Function ResolveType() As Boolean
        Dim result As Boolean = True

        If m_Inherits IsNot Nothing Then
            result = m_Inherits.ResolveTypeReferences AndAlso result
            If result = False Then Return result
            BaseType = m_Inherits.ResolvedType
        Else
            BaseType = Compiler.TypeCache.System_Object
#If DEBUGREFLECTION Then
            Helper.DebugReflection_AppendLine(String.Format("{0} = GetType(Object)", Helper.GetObjectName(BaseType)))
#End If
        End If

        result = MyBase.ResolveType AndAlso result

        Helper.Assert(BaseType IsNot Nothing)

        'Find the default constructors for this class
        Me.FindDefaultConstructors()

        Return result
    End Function

    Public Overrides Function ResolveCode(ByVal Info As ResolveInfo) As Boolean
        Dim result As Boolean = True

        result = MyBase.ResolveCode(Info) AndAlso result
        'vbnc.Helper.Assert(result = (Compiler.Report.Errors = 0))

        Return result
    End Function

    Private Function CreateImplicitMembers() As Boolean Implements IHasImplicitMembers.CreateImplicitMembers
        Dim result As Boolean = True
        'If a type contains no instance constructor declarations, a default constructor 
        'is automatically provided. The default constructor simply invokes the 
        'parameterless constructor of the direct base type. If the direct 
        'base type does not have an accessible parameterless constructor, 
        'a compile-time error occurs. 
        'The declared access type for the default constructor is always Public. 
        If HasInstanceConstructors = False Then
            Dim baseDefaultCtor As ConstructorInfo
            baseDefaultCtor = Me.GetBaseDefaultConstructor()

            If baseDefaultCtor IsNot Nothing Then
                If baseDefaultCtor.IsPrivate Then
                    Helper.AddError("No default constructor can be created because base class has no accessible default constructor.")
                    result = False
                Else
                    DefaultInstanceConstructor = ConstructorDeclaration.CreateDefaultConstructor(Me)
                    Members.Add(DefaultInstanceConstructor)
                End If
            Else
                Helper.AddError("No default constructor can be created because base class has no default constructor.")
                result = False
            End If
        End If

        If DefaultSharedConstructor Is Nothing AndAlso Me.HasSharedFieldsWithInitializers Then
            DefaultSharedConstructor = ConstructorDeclaration.CreateTypeConstructor(Me)
            Members.Add(DefaultSharedConstructor)
            BeforeFieldInit = True
        End If

        result = CreateMyGroupMembers() AndAlso result

        Return result
    End Function

    Private Function CreateMyGroupMembers() As Boolean
        Dim result As Boolean = True

        If Me.CustomAttributes Is Nothing Then Return result

        Dim attrib As Attribute
        Dim attribs As Generic.List(Of Attribute)

        attribs = Me.CustomAttributes.FindAttributes(Compiler.TypeCache.MS_VB_MyGroupCollectionAttribute)

        If attribs Is Nothing Then Return result
        If attribs.Count <> 1 Then Return result

        attrib = attribs(0)

        Dim groupData As New MyGroupData
        Dim typeToCollect As String
        Dim createInstanceMethodName As String
        Dim disposeInstanceMethodName As String
        Dim defaultInstanceAlias As String

        If Not attrib.ResolveCode(ResolveInfo.Default(Compiler)) Then
            'The attribute is not instantiated correctly, this will cause an error on the attribute
            'no need to show more errors here.
            Return result
        End If

        'Check the number of arguments and their types
        'There should be 4 string arguments, if not there's something wrong with
        'the MyGroupCollectionAttribute (won't reach here if the code is wrong
        'because we resolve the attribute first)
        'It's also safe to index the arguments, since attributes can't have named constructor parameters.
        Dim args As Object() = attrib.Arguments
        If args Is Nothing OrElse args.Length <> 4 Then
            Throw New InternalException("Weird MyGroupCollectionAttribute, should have 4 arguments.")
        Else
            For Each arg As Object In args
                If arg Is Nothing Then Continue For
                If TypeOf arg Is String Then Continue For
                Throw New InternalException("Weird MyGroupCollectionAttribute, non-string argument?")
            Next
        End If
        typeToCollect = DirectCast(args(0), String)
        createInstanceMethodName = DirectCast(args(1), String)
        disposeInstanceMethodName = DirectCast(args(2), String)
        defaultInstanceAlias = DirectCast(args(3), String)

        If typeToCollect = String.Empty Then Return result
        If createInstanceMethodName = String.Empty Then Return result
        If disposeInstanceMethodName = String.Empty Then Return result

        Dim collectType As Type
        Dim foundTypes As Generic.List(Of Type)
        foundTypes = Compiler.TypeManager.GetType(typeToCollect, False)
        If foundTypes.Count <> 1 Then
            Return result
        End If
        collectType = foundTypes(0)
        groupData.TypeToCollect = collectType

        For Each mi As MethodDeclaration In Members.GetSpecificMembers(Of MethodDeclaration)()
            If mi.IsShared AndAlso NameResolution.CompareName(createInstanceMethodName, mi.Name) Then
                If mi.Signature.Parameters.Count <> 1 Then Continue For
                If mi.Signature.TypeParameters Is Nothing OrElse mi.Signature.TypeParameters.Parameters.Count <> 1 Then Continue For
                If mi.Signature.ReturnType Is Nothing Then Continue For

                Dim T As TypeParameter = mi.Signature.TypeParameters.Parameters(0)