1'
2' Visual Basic.Net Compiler
3' Copyright (C) 2004 - 2010 Rolf Bjarne Kvinge, RKvinge@novell.com
4'
5' This library is free software; you can redistribute it and/or
6' modify it under the terms of the GNU Lesser General Public
7' License as published by the Free Software Foundation; either
8' version 2.1 of the License, or (at your option) any later version.
9'
10' This library is distributed in the hope that it will be useful,
11' but WITHOUT ANY WARRANTY; without even the implied warranty of
12' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13' Lesser General Public License for more details.
14'
15' You should have received a copy of the GNU Lesser General Public
16' License along with this library; if not, write to the Free Software
17' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
18'
19
20Imports System.Reflection.Emit
21Imports System.Reflection
22
23''' <summary>
24''' ConstructorMemberDeclaration  ::=
25''' [  Attributes  ]  [  ConstructorModifier+  ]  "Sub" "New" [  "("  [  ParameterList  ]  ")"  ]  LineTerminator
26'''	[  Block  ]
27'''	"End" "Sub" StatementTerminator
28''' </summary>
29''' <remarks></remarks>
30Public Class ConstructorDeclaration
31    Inherits MethodBaseDeclaration
32    Implements IConstructorMember
33
34    'Private m_Descriptor As New ConstructorDescriptor(Me)
35
36    Public Const ConstructorName As String = ".ctor"
37    Public Const SharedConstructorName As String = ".cctor"
38
39    'Private m_ConstructorBuilder As ConstructorBuilder
40
41    'Private m_CecilBuilder As Mono.Cecil.MethodDefinition
42    Private m_DefaultBaseConstructorCecil As Mono.Cecil.MethodReference
43
44    ''' <summary>
45    ''' The default base constructor to call if no call is specified in the code.
46    ''' </summary>
47    ''' <remarks></remarks>
48    Private m_DefaultBaseConstructor As Mono.Cecil.MethodReference
49
50    ''' <summary>
51    ''' The base/self constructor call in the code.
52    ''' </summary>
53    ''' <remarks></remarks>
54    Private m_BaseCtorCall As Statement
55    Private m_Added As Boolean
56
57    Sub New(ByVal Parent As TypeDeclaration)
58        MyBase.New(Parent)
59    End Sub
60
61    Shadows Sub Init(ByVal Code As CodeBlock)
62        MyBase.Init(New Modifiers(), New SubSignature(Me, ConstructorName, New ParameterList(Me)), Code)
63    End Sub
64
65    Shadows Sub Init(ByVal Modifiers As Modifiers, ByVal Signature As SubSignature, ByVal Block As CodeBlock)
66
67        'If vbnc.Modifiers.IsNothing(Modifiers) = False AndAlso Modifiers.Is(ModifierMasks.Shared) Then
68        If Modifiers.Is(ModifierMasks.Shared) OrElse FindTypeParent.IsModule Then
69            Signature.Init(New Identifier(Signature, SharedConstructorName, Signature.Location, TypeCharacters.Characters.None), Signature.TypeParameters, Signature.Parameters)
70        Else
71            Signature.Init(New Identifier(Signature, ConstructorName, Signature.Location, TypeCharacters.Characters.None), Signature.TypeParameters, Signature.Parameters)
72        End If
73
74        MyBase.Init(Modifiers, Signature, Block)
75    End Sub
76
77    ReadOnly Property ExplicitCtorCall() As Mono.Cecil.MethodReference
78        Get
79            Dim firststatement As BaseObject
80            Dim cs As CallStatement
81            Dim ie As InvocationOrIndexExpression
82            Dim ctor As Mono.Cecil.MethodReference
83
84            firststatement = Code.FirstStatement
85            If firststatement Is Nothing Then Return Nothing
86
87            cs = TryCast(firststatement, CallStatement)
88            If cs Is Nothing Then Return Nothing
89
90            ie = TryCast(cs.Target, InvocationOrIndexExpression)
91            If ie Is Nothing Then Return Nothing
92            If ie.Expression.Classification.IsMethodGroupClassification = False Then Return Nothing
93
94            ctor = ie.Expression.Classification.AsMethodGroupClassification.ResolvedConstructor
95            If ctor Is Nothing Then Return Nothing
96
97            If Helper.CompareNameOrdinal(ctor.Name, ConstructorDeclaration.ConstructorName) = False Then Return Nothing
98
99            If Helper.CompareType(CecilHelper.FindDefinition(ctor.DeclaringType), CecilHelper.FindDefinition(Me.FindTypeParent.BaseType)) Then
100                Return ctor
101            ElseIf Helper.CompareType(CecilHelper.FindDefinition(ctor.DeclaringType), CecilHelper.FindDefinition(Me.FindTypeParent.CecilType)) Then
102                Return ctor
103            Else
104                Return Nothing
105            End If
106        End Get
107    End Property
108
109    ReadOnly Property HasExplicitCtorCall() As Boolean
110        Get
111            Return ExplicitCtorCall IsNot Nothing
112        End Get
113    End Property
114
115    Overrides Function ResolveCode(ByVal Info As ResolveInfo) As Boolean
116        Dim result As Boolean = True
117
118        result = MyBase.ResolveCode(Info) AndAlso result
119
120        If result = False Then Return result
121
122        If Me.IsShared = False AndAlso Me.HasMethodBody AndAlso Me.HasExplicitCtorCall = False Then
123            CreateDefaultCtorCall()
124            CreateDefaultCtorCallCecil()
125        ElseIf Code IsNot Nothing AndAlso Me.HasExplicitCtorCall Then
126            m_BaseCtorCall = Code.FirstStatement
127            If m_BaseCtorCall IsNot Nothing Then Code.RemoveStatement(m_BaseCtorCall)
128        End If
129
130        If Me.IsShared AndAlso (Me.Modifiers.Mask And Me.Modifiers.AccessibilityMask) <> 0 Then
131            Select Case Me.Modifiers.Mask And Me.Modifiers.AccessibilityMask
132                Case ModifierMasks.Private
133                    result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Private")
134                Case ModifierMasks.Protected
135                    result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Protected")
136                Case ModifierMasks.Friend
137                    result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Friend")
138                Case ModifierMasks.Protected Or ModifierMasks.Friend
139                    result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Protected Friend")
140                Case ModifierMasks.Public
141                    result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Public")
142            End Select
143        End If
144
145        Return result
146    End Function
147
148    Public Overrides Function CreateDefinition() As Boolean
149        Dim result As Boolean = True
150
151        result = MyBase.CreateDefinition AndAlso result
152
153        MethodImplAttributes = Mono.Cecil.MethodImplAttributes.IL
154
155        Return result
156    End Function
157
158    Friend Overrides Function GenerateCode(ByVal Info As EmitInfo) As Boolean
159        Dim result As Boolean = True
160
161        If CBool(MethodImplAttributes And Mono.Cecil.MethodImplAttributes.Runtime) Then
162            Return result
163        End If
164
165        Helper.Assert(Info Is Nothing)
166        Dim parent As IType = Me.FindTypeParent
167        Info = New EmitInfo(Me)
168
169#If DEBUG Then
170        Info.ILGen.Emit(Mono.Cecil.Cil.OpCodes.Nop)
171#End If
172
173        Dim ParentType As Mono.Cecil.TypeReference
174        ParentType = parent.CecilType
175        If TypeOf parent Is StructureDeclaration AndAlso Me.IsShared = False Then
176            Emitter.EmitLoadMe(Info, parent.CecilType)
177            Emitter.EmitInitObj(Info, parent.CecilType)
178        ElseIf m_DefaultBaseConstructor IsNot Nothing Then
179            Dim params As Mono.Collections.Generic.Collection(Of ParameterDefinition) = m_DefaultBaseConstructor.Parameters
180            Emitter.EmitLoadMe(Info, CecilHelper.FindDefinition(ParentType).BaseType)
181            For i As Integer = 0 To params.Count - 1
182                Helper.Assert(params(i).IsOptional)
183                Emitter.EmitLoadValue(Info.Clone(Me, True, False, params(i).ParameterType), params(i).Constant)
184            Next
185
186            Emitter.EmitCall(Info, m_DefaultBaseConstructor)
187        ElseIf m_BaseCtorCall IsNot Nothing Then
188            result = m_BaseCtorCall.GenerateCode(Info)
189        Else
190            Helper.Assert(Me.IsShared)
191        End If
192
193        Dim exCtorCall As Mono.Cecil.MethodReference = ExplicitCtorCall
194        If m_BaseCtorCall Is Nothing OrElse (exCtorCall IsNot Nothing AndAlso Helper.CompareType(exCtorCall.DeclaringType, Me.DeclaringType.CecilType) = False) Then
195            result = EmitVariableInitialization(Info) AndAlso result
196
197            If Not IsShared Then
198                For Each arhs As AddOrRemoveHandlerStatement In Me.DeclaringType.AddHandlers
199                    result = arhs.GenerateCode(Info) AndAlso result
200                Next
201            End If
202        End If
203
204        If Me.IsShared Then
205            result = EmitConstantInitialization(Info) AndAlso result
206        End If
207
208#If DEBUG Then
209        Info.ILGen.Emit(Mono.Cecil.Cil.OpCodes.Nop)
210#End If
211
212        result = MyBase.GenerateCode(Info) AndAlso result
213
214        Return result
215    End Function
216
217    Private Function EmitVariableInitialization(ByVal Info As EmitInfo) As Boolean
218        Dim variables As Generic.List(Of TypeVariableDeclaration)
219        Dim parent As TypeDeclaration
220        Dim result As Boolean = True
221
222        parent = Me.DeclaringType
223        variables = parent.Members.GetSpecificMembers(Of TypeVariableDeclaration)()
224
225        For Each variable As TypeVariableDeclaration In variables
226            If variable.HasInitializer AndAlso variable.IsShared = Me.IsShared Then
227                result = variable.EmitVariableInitializer(Info) AndAlso result
228            End If
229        Next
230
231        For Each variable As LocalVariableDeclaration In parent.StaticVariables
232            If variable.HasInitializer AndAlso variable.DeclaringMethod.IsShared = Me.IsShared Then
233                If Me.IsShared = False Then Emitter.EmitLoadMe(Info, Me.DeclaringType.CecilType)
234                result = variable.CreateDefinition AndAlso result
235                Emitter.EmitNew(Info, Compiler.TypeCache.MS_VB_CS_StaticLocalInitFlag__ctor)
236                Emitter.EmitStoreField(Info, CecilHelper.GetCorrectMember(variable.StaticInitBuilder, variable.StaticInitBuilder.DeclaringType))
237            End If
238        Next
239
240        Return result
241    End Function
242
243    Private Function EmitConstantInitialization(ByVal Info As EmitInfo) As Boolean
244        Dim result As Boolean = True
245        Dim parent As TypeDeclaration
246        Dim constant As Object = Nothing
247
248        Parent = Me.DeclaringType
249
250        For Each variable As ConstantDeclaration In parent.Members.GetSpecificMembers(Of ConstantDeclaration)()
251            result = variable.GetConstant(constant, True) AndAlso result
252            If Helper.CompareType(variable.FieldType, Compiler.TypeCache.System_DateTime) Then
253                Emitter.EmitLoadDateValue(Info, DirectCast(constant, Date))
254                Emitter.EmitStoreField(Info, variable.FieldBuilder)
255            ElseIf Helper.CompareType(variable.FieldType, Compiler.TypeCache.System_Decimal) Then
256                Emitter.EmitLoadDecimalValue(Info, DirectCast(constant, Decimal))
257                Emitter.EmitStoreField(Info, variable.FieldBuilder)
258            End If
259        Next
260
261        Return result
262    End Function
263
264    Private Sub CreateDefaultCtorCall()
265        Dim type As TypeDeclaration = Me.FindFirstParent(Of TypeDeclaration)()
266        Dim classtype As ClassDeclaration = TryCast(type, ClassDeclaration)
267        Dim defaultctor As Mono.Cecil.MethodReference
268        If classtype IsNot Nothing Then
269            defaultctor = classtype.GetBaseDefaultConstructor()
270            If defaultctor IsNot Nothing AndAlso Helper.IsPrivate(defaultctor) = False Then
271                If Helper.IsPrivate(defaultctor) OrElse (Helper.IsFriend(defaultctor) AndAlso Not Compiler.Assembly.IsDefinedHere(defaultctor.DeclaringType)) Then
272                    Helper.AddError(Me, "Base class does not have an accessible default constructor")
273                Else
274                    m_DefaultBaseConstructor = defaultctor
275
276#If DEBUG Then
277                    Try
278                        For Each param As Mono.Cecil.ParameterDefinition In m_DefaultBaseConstructor.Parameters
279                            Helper.Assert(param.IsOptional)
280                        Next
281                    Catch ex As Exception
282                        Helper.Assert(False)
283                    End Try
284#End If
285                End If
286            End If
287        End If
288    End Sub
289
290    Private Sub CreateDefaultCtorCallCecil()
291        Dim type As TypeDeclaration = Me.FindFirstParent(Of TypeDeclaration)()
292        Dim classtype As ClassDeclaration = TryCast(type, ClassDeclaration)
293        Dim defaultctor As Mono.Cecil.MethodReference
294        If classtype IsNot Nothing Then
295            defaultctor = classtype.GetBaseDefaultConstructorCecil()
296            If defaultctor IsNot Nothing AndAlso Helper.IsPrivate(defaultctor) = False Then
297                If Helper.IsPrivate(defaultctor) OrElse (Helper.IsFamilyOrAssembly(defaultctor) AndAlso defaultctor.DeclaringType.Module.Assembly IsNot Me.Compiler.AssemblyBuilderCecil) Then
298                    Helper.AddError(Compiler, Location, "Base class does not have an accessible default constructor")
299                Else
300                    m_DefaultBaseConstructorCecil = defaultctor
301                    m_DefaultBaseConstructorCecil = Helper.GetMethodOrMethodReference(Compiler, m_DefaultBaseConstructorCecil)
302
303#If DEBUG Then
304                    Try
305                        For Each param As Mono.Cecil.ParameterDefinition In m_DefaultBaseConstructor.Parameters
306                            Helper.Assert(param.IsOptional)
307                        Next
308                    Catch ex As Exception
309                        Helper.Assert(False)
310                    End Try
311#End If
312                End If
313            End If
314        End If
315    End Sub
316
317    Shared Function IsMe(ByVal tm As tm) As Boolean
318        Dim i As Integer
319        While tm.PeekToken(i).Equals(ModifierMasks.ConstructorModifiers)
320            i += 1
321        End While
322        If tm.PeekToken(i).Equals(KS.Sub) = False Then Return False
323        Return tm.PeekToken(i + 1).Equals(KS.[New])
324    End Function
325End Class
326