@@ -20,30 +20,36 @@ public class UseMeaningfulNameInspectionTests
2020 {
2121 [ TestMethod ]
2222 [ TestCategory ( "Inspections" ) ]
23- public void UseMeaningfulName_ReturnsResult_NameWithoutVowels ( )
23+ public void UseMeaningfulName_ReturnsResult_NameWithAllTheSameLetters ( )
2424 {
25- const string inputCode =
26- @"Sub Ffffff()
25+ const string inputCode =
26+ @"
27+ Private aaa As String
28+ Private bbb As String
29+ Private ccc As String
30+ Private ddd As String
31+ Private eee As String
32+ Private iii As String
33+ Private ooo As String
34+ Private uuu As String
35+
36+ Sub Eeeeee()
37+ Dim a2z as String 'This is the only declaration that should pass
38+ Dim gGGG as String
2739End Sub" ;
2840
29- //Arrange
30- var builder = new MockVbeBuilder ( ) ;
31- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
32- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
33- . Build ( ) ;
34- var vbe = builder . AddProject ( project ) . Build ( ) ;
35-
36- var mockHost = new Mock < IHostApplication > ( ) ;
37- mockHost . SetupAllProperties ( ) ;
38- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
39-
40- parser . Parse ( new CancellationTokenSource ( ) ) ;
41- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
41+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 10 ) ;
42+ }
4243
43- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
44- var inspectionResults = inspection . GetInspectionResults ( ) ;
4544
46- Assert . AreEqual ( 1 , inspectionResults . Count ( ) ) ;
45+ [ TestMethod ]
46+ [ TestCategory ( "Inspections" ) ]
47+ public void UseMeaningfulName_ReturnsResult_NameWithoutVowels ( )
48+ {
49+ const string inputCode =
50+ @"Sub Ffffff()
51+ End Sub" ;
52+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 1 ) ;
4753 }
4854
4955 [ TestMethod ]
@@ -53,25 +59,7 @@ public void UseMeaningfulName_ReturnsResult_NameUnderThreeLetters()
5359 const string inputCode =
5460@"Sub Oo()
5561End Sub" ;
56-
57- //Arrange
58- var builder = new MockVbeBuilder ( ) ;
59- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
60- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
61- . Build ( ) ;
62- var vbe = builder . AddProject ( project ) . Build ( ) ;
63-
64- var mockHost = new Mock < IHostApplication > ( ) ;
65- mockHost . SetupAllProperties ( ) ;
66- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
67-
68- parser . Parse ( new CancellationTokenSource ( ) ) ;
69- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
70-
71- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
72- var inspectionResults = inspection . GetInspectionResults ( ) ;
73-
74- Assert . AreEqual ( 1 , inspectionResults . Count ( ) ) ;
62+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 1 ) ;
7563 }
7664
7765 [ TestMethod ]
@@ -82,24 +70,7 @@ public void UseMeaningfulName_ReturnsResult_NameEndsWithDigit()
8270@"Sub Foo1()
8371End Sub" ;
8472
85- //Arrange
86- var builder = new MockVbeBuilder ( ) ;
87- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
88- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
89- . Build ( ) ;
90- var vbe = builder . AddProject ( project ) . Build ( ) ;
91-
92- var mockHost = new Mock < IHostApplication > ( ) ;
93- mockHost . SetupAllProperties ( ) ;
94- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
95-
96- parser . Parse ( new CancellationTokenSource ( ) ) ;
97- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
98-
99- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
100- var inspectionResults = inspection . GetInspectionResults ( ) ;
101-
102- Assert . AreEqual ( 1 , inspectionResults . Count ( ) ) ;
73+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 1 ) ;
10374 }
10475
10576 [ TestMethod ]
@@ -110,24 +81,7 @@ public void UseMeaningfulName_DoesNotReturnsResult_GoodName_LowerCaseVowels()
11081@"Sub FooBar()
11182End Sub" ;
11283
113- //Arrange
114- var builder = new MockVbeBuilder ( ) ;
115- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
116- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
117- . Build ( ) ;
118- var vbe = builder . AddProject ( project ) . Build ( ) ;
119-
120- var mockHost = new Mock < IHostApplication > ( ) ;
121- mockHost . SetupAllProperties ( ) ;
122- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
123-
124- parser . Parse ( new CancellationTokenSource ( ) ) ;
125- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
126-
127- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
128- var inspectionResults = inspection . GetInspectionResults ( ) ;
129-
130- Assert . AreEqual ( 0 , inspectionResults . Count ( ) ) ;
84+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 0 ) ;
13185 }
13286
13387 [ TestMethod ]
@@ -138,24 +92,7 @@ public void UseMeaningfulName_DoesNotReturnsResult_GoodName_UpperCaseVowels()
13892@"Sub FOOBAR()
13993End Sub" ;
14094
141- //Arrange
142- var builder = new MockVbeBuilder ( ) ;
143- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
144- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
145- . Build ( ) ;
146- var vbe = builder . AddProject ( project ) . Build ( ) ;
147-
148- var mockHost = new Mock < IHostApplication > ( ) ;
149- mockHost . SetupAllProperties ( ) ;
150- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
151-
152- parser . Parse ( new CancellationTokenSource ( ) ) ;
153- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
154-
155- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
156- var inspectionResults = inspection . GetInspectionResults ( ) ;
157-
158- Assert . AreEqual ( 0 , inspectionResults . Count ( ) ) ;
95+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 0 ) ;
15996 }
16097
16198 [ TestMethod ]
@@ -165,24 +102,7 @@ public void UseMeaningfulName_DoesNotReturnsResult_OptionBase()
165102 const string inputCode =
166103@"Option Base 1" ;
167104
168- //Arrange
169- var builder = new MockVbeBuilder ( ) ;
170- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
171- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
172- . Build ( ) ;
173- var vbe = builder . AddProject ( project ) . Build ( ) ;
174-
175- var mockHost = new Mock < IHostApplication > ( ) ;
176- mockHost . SetupAllProperties ( ) ;
177- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
178-
179- parser . Parse ( new CancellationTokenSource ( ) ) ;
180- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
181-
182- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
183- var inspectionResults = inspection . GetInspectionResults ( ) ;
184-
185- Assert . AreEqual ( 0 , inspectionResults . Count ( ) ) ;
105+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 0 ) ;
186106 }
187107
188108 [ TestMethod ]
@@ -193,24 +113,7 @@ public void UseMeaningfulName_DoesNotReturnResult_NameWithoutVowels_NameIsInWhit
193113@"Sub sss()
194114End Sub" ;
195115
196- //Arrange
197- var builder = new MockVbeBuilder ( ) ;
198- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
199- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
200- . Build ( ) ;
201- var vbe = builder . AddProject ( project ) . Build ( ) ;
202-
203- var mockHost = new Mock < IHostApplication > ( ) ;
204- mockHost . SetupAllProperties ( ) ;
205- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
206-
207- parser . Parse ( new CancellationTokenSource ( ) ) ;
208- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
209-
210- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
211- var inspectionResults = inspection . GetInspectionResults ( ) ;
212-
213- Assert . IsFalse ( inspectionResults . Any ( ) ) ;
116+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 0 ) ;
214117 }
215118
216119 [ TestMethod ]
@@ -222,24 +125,7 @@ public void UseMeaningfulName_Ignored_DoesNotReturnResult()
222125Sub Ffffff()
223126End Sub" ;
224127
225- //Arrange
226- var builder = new MockVbeBuilder ( ) ;
227- var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
228- . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
229- . Build ( ) ;
230- var vbe = builder . AddProject ( project ) . Build ( ) ;
231-
232- var mockHost = new Mock < IHostApplication > ( ) ;
233- mockHost . SetupAllProperties ( ) ;
234- var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
235-
236- parser . Parse ( new CancellationTokenSource ( ) ) ;
237- if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
238-
239- var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
240- var inspectionResults = inspection . GetInspectionResults ( ) ;
241-
242- Assert . IsFalse ( inspectionResults . Any ( ) ) ;
128+ AssertVbaFragmentYieldsExpectedInspectionResultCount ( inputCode , 0 ) ;
243129 }
244130
245131 [ TestMethod ]
@@ -272,7 +158,6 @@ Sub Ffffff()
272158
273159 var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
274160 var inspectionResults = inspection . GetInspectionResults ( ) ;
275-
276161 inspectionResults . First ( ) . QuickFixes . Single ( s => s is IgnoreOnceQuickFix ) . Fix ( ) ;
277162
278163 Assert . AreEqual ( expectedCode , module . Content ( ) ) ;
@@ -296,6 +181,26 @@ public void InspectionName()
296181 Assert . AreEqual ( inspectionName , inspection . Name ) ;
297182 }
298183
184+ private void AssertVbaFragmentYieldsExpectedInspectionResultCount ( string inputCode , int expectedCount )
185+ {
186+ var builder = new MockVbeBuilder ( ) ;
187+ var project = builder . ProjectBuilder ( "VBAProject" , ProjectProtection . Unprotected )
188+ . AddComponent ( "MyClass" , ComponentType . ClassModule , inputCode )
189+ . Build ( ) ;
190+ var vbe = builder . AddProject ( project ) . Build ( ) ;
191+
192+ var mockHost = new Mock < IHostApplication > ( ) ;
193+ mockHost . SetupAllProperties ( ) ;
194+ var parser = MockParser . Create ( vbe . Object , new RubberduckParserState ( new Mock < ISinks > ( ) . Object ) ) ;
195+
196+ parser . Parse ( new CancellationTokenSource ( ) ) ;
197+ if ( parser . State . Status >= ParserState . Error ) { Assert . Inconclusive ( "Parser Error" ) ; }
198+
199+ var inspection = new UseMeaningfulNameInspection ( null , parser . State , GetInspectionSettings ( ) . Object ) ;
200+ var inspectionResults = inspection . GetInspectionResults ( ) ;
201+ Assert . AreEqual ( expectedCount , inspectionResults . Count ( ) ) ;
202+ }
203+
299204 internal static Mock < IPersistanceService < CodeInspectionSettings > > GetInspectionSettings ( )
300205 {
301206 var settings = new Mock < IPersistanceService < CodeInspectionSettings > > ( ) ;
0 commit comments