6
6
using Rubberduck . Inspections . QuickFixes ;
7
7
using Rubberduck . Inspections . Resources ;
8
8
using Rubberduck . Parsing . VBA ;
9
- using Rubberduck . VBEditor . Events ;
10
9
using Rubberduck . VBEditor . SafeComWrappers . Abstract ;
11
10
using RubberduckTests . Mocks ;
12
11
using System . Collections . Generic ;
13
- using System ;
14
- using Rubberduck . Parsing . Symbols ;
15
12
using Rubberduck . VBEditor . SafeComWrappers ;
16
13
17
14
namespace RubberduckTests . Inspections
@@ -125,156 +122,6 @@ End Sub
125
122
Assert . AreEqual ( 0 , results . Count ( ) ) ;
126
123
}
127
124
128
- [ TestMethod ]
129
- [ TestCategory ( "Inspections" ) ]
130
- public void AssignedByValParameter_QuickFixWorks ( )
131
- {
132
-
133
- string inputCode =
134
- @"Public Sub Foo(Optional ByVal barByVal As String = ""XYZ"")
135
- Let barByVal = ""test""
136
- End Sub" ;
137
- string expectedCode =
138
- @"Public Sub Foo(Optional ByRef barByVal As String = ""XYZ"")
139
- Let barByVal = ""test""
140
- End Sub" ;
141
-
142
- var quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
143
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
144
-
145
- //check when ByVal argument is one of several parameters
146
- inputCode =
147
- @"Public Sub Foo(ByRef firstArg As Long, Optional ByVal barByVal As String = """", secondArg as Double)
148
- Let barByVal = ""test""
149
- End Sub" ;
150
- expectedCode =
151
- @"Public Sub Foo(ByRef firstArg As Long, Optional ByRef barByVal As String = """", secondArg as Double)
152
- Let barByVal = ""test""
153
- End Sub" ;
154
-
155
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
156
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
157
-
158
- inputCode =
159
- @"
160
- Private Sub Foo(Optional ByVal _
161
- bar _
162
- As _
163
- Long = 4, _
164
- ByVal _
165
- barTwo _
166
- As _
167
- Long)
168
- bar = 42
169
- End Sub
170
- "
171
- ;
172
- expectedCode =
173
- @"
174
- Private Sub Foo(Optional ByRef _
175
- bar _
176
- As _
177
- Long = 4, _
178
- ByVal _
179
- barTwo _
180
- As _
181
- Long)
182
- bar = 42
183
- End Sub
184
- "
185
- ;
186
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
187
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
188
-
189
- inputCode =
190
- @"Private Sub Foo(ByVal barByVal As Long, ByVal _xByValbar As Long, ByVal _
191
- barTwo _
192
- As _
193
- Long)
194
- barTwo = 42
195
- End Sub
196
- " ;
197
- expectedCode =
198
- @"Private Sub Foo(ByVal barByVal As Long, ByVal _xByValbar As Long, ByRef _
199
- barTwo _
200
- As _
201
- Long)
202
- barTwo = 42
203
- End Sub
204
- " ;
205
-
206
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
207
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
208
-
209
- inputCode =
210
- @"Private Sub Foo(ByVal barByVal As Long, ByVal barTwoon As Long, ByVal _
211
- barTwo _
212
- As _
213
- Long)
214
- barTwo = 42
215
- End Sub
216
- " ;
217
- expectedCode =
218
- @"Private Sub Foo(ByVal barByVal As Long, ByVal barTwoon As Long, ByRef _
219
- barTwo _
220
- As _
221
- Long)
222
- barTwo = 42
223
- End Sub
224
- " ;
225
-
226
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
227
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
228
-
229
- inputCode =
230
- @"Private Sub Foo(ByVal barByVal As Long, ByVal barTwoon As Long, ByVal barTwo _
231
- As _
232
- Long)
233
- barTwo = 42
234
- End Sub
235
- " ;
236
- expectedCode =
237
- @"Private Sub Foo(ByVal barByVal As Long, ByVal barTwoon As Long, ByRef barTwo _
238
- As _
239
- Long)
240
- barTwo = 42
241
- End Sub
242
- " ;
243
-
244
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
245
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
246
-
247
- inputCode =
248
- @"Sub DoSomething(_
249
- ByVal foo As Long, _
250
- ByRef _
251
- bar, _
252
- ByRef barbecue _
253
- )
254
- foo = 4
255
- bar = barbecue * _
256
- bar + foo / barbecue
257
- End Sub
258
- " ;
259
-
260
- expectedCode =
261
- @"Sub DoSomething(_
262
- ByRef foo As Long, _
263
- ByRef _
264
- bar, _
265
- ByRef barbecue _
266
- )
267
- foo = 4
268
- bar = barbecue * _
269
- bar + foo / barbecue
270
- End Sub
271
- " ;
272
- quickFixResult = ApplyPassParameterByReferenceQuickFixToCodeFragment ( inputCode ) ;
273
- Assert . AreEqual ( expectedCode , quickFixResult ) ;
274
-
275
- }
276
-
277
-
278
125
[ TestMethod ]
279
126
[ TestCategory ( "Inspections" ) ]
280
127
public void AssignedByValParameter_IgnoreQuickFixWorks ( )
@@ -312,17 +159,12 @@ public void InspectionName()
312
159
}
313
160
314
161
315
- private string ApplyPassParameterByReferenceQuickFixToCodeFragment ( string inputCode )
162
+ private void AssertVbaFragmentYieldsExpectedInspectionResultCount ( string inputCode , int expectedCount )
316
163
{
317
- var vbe = BuildMockVBEStandardModuleForVBAFragment ( inputCode ) ;
318
- var inspectionResults = GetInspectionResults ( vbe ) ;
319
-
320
- inspectionResults . First ( ) . QuickFixes . Single ( s => s is PassParameterByReferenceQuickFix ) . Fix ( ) ;
321
-
322
- return GetModuleContent ( vbe ) ;
164
+ var inspectionResults = GetInspectionResults ( inputCode ) ;
165
+ Assert . AreEqual ( expectedCount , inspectionResults . Count ( ) ) ;
323
166
}
324
167
325
-
326
168
private string ApplyIgnoreOnceQuickFixToCodeFragment ( string inputCode )
327
169
{
328
170
var vbe = BuildMockVBEStandardModuleForVBAFragment ( inputCode ) ;
@@ -348,31 +190,20 @@ private string GetModuleContent(Mock<IVBE> vbe)
348
190
349
191
private IEnumerable < Rubberduck . Inspections . Abstract . InspectionResultBase > GetInspectionResults ( Mock < IVBE > vbe )
350
192
{
351
- var parser = GetMockParseCoordinator ( vbe ) ;
193
+ var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( vbe . Object ) ) ;
194
+ parser . Parse ( new CancellationTokenSource ( ) ) ;
195
+ if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
196
+
352
197
var inspection = new AssignedByValParameterInspection ( parser . State ) ;
353
198
return inspection . GetInspectionResults ( ) ;
354
199
}
355
200
356
- private void AssertVbaFragmentYieldsExpectedInspectionResultCount ( string inputCode , int expectedCount )
357
- {
358
- var inspectionResults = GetInspectionResults ( inputCode ) ;
359
- Assert . AreEqual ( expectedCount , inspectionResults . Count ( ) ) ;
360
- }
361
-
362
201
private Mock < IVBE > BuildMockVBEStandardModuleForVBAFragment ( string inputCode )
363
202
{
364
203
var builder = new MockVbeBuilder ( ) ;
365
204
IVBComponent component ;
366
205
return builder . BuildFromSingleStandardModule ( inputCode , out component ) ;
367
206
368
207
}
369
- private ParseCoordinator GetMockParseCoordinator ( Mock < IVBE > vbe )
370
- {
371
- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( vbe . Object ) ) ;
372
-
373
- parser . Parse ( new CancellationTokenSource ( ) ) ;
374
- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
375
- return parser ;
376
- }
377
208
}
378
209
}
0 commit comments