Skip to content

Commit c42d422

Browse files
authored
Merge pull request #173 from rubberduck-vba/next
sync with main repo
2 parents 66fa003 + b6c84b2 commit c42d422

File tree

7 files changed

+244
-194
lines changed

7 files changed

+244
-194
lines changed

RetailCoder.VBE/API/ParserState.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ public void Initialize(VBE vbe)
7373
Func<IVBAPreprocessor> preprocessorFactory = () => new VBAPreprocessor(double.Parse(vbe.Version, CultureInfo.InvariantCulture));
7474
_attributeParser = new AttributeParser(new ModuleExporter(), preprocessorFactory);
7575
_parser = new RubberduckParser(vbe, _state, _attributeParser, preprocessorFactory,
76-
new List<ICustomDeclarationLoader> { new DebugDeclarations(_state), new FormEventDeclarations(_state), new AliasDeclarations(_state) });
76+
new List<ICustomDeclarationLoader> { new DebugDeclarations(_state), new SpecialFormDeclarations(_state), new FormEventDeclarations(_state), new AliasDeclarations(_state) });
7777
}
7878

7979
/// <summary>

RetailCoder.VBE/Inspections/InspectionsUI.de.resx

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -565,30 +565,30 @@ Falls der Parameter 'null' sein kann, bitte dieses Auftreten ignorieren. 'null'
565565
<value>Eine Annotation in einem Kommentar konnte nicht gelesen werden.</value>
566566
</data>
567567
<data name="IntroduceLocalVariableQuickFix" xml:space="preserve">
568-
<value>Introduce local variable</value>
568+
<value>Lokale Variable einführen</value>
569569
</data>
570570
<data name="UndeclaredVariableInspectionMeta" xml:space="preserve">
571-
<value>Code that uses undeclared variables does not compile when Option Explicit is specified. Undeclared variables are always Variant, a data type that incurs unnecessary overhead and storage.</value>
571+
<value>Code, der undeklarierte Variablen verwendet, kompiliert nicht wenn 'Option Explicit' spezifiziert wird. Undeklarierte Variablen sind immer vom Typ 'Variant', was unnötige Zusatzkosten in Ausführungszeit und Speicherverbauch verursacht.</value>
572572
</data>
573573
<data name="WriteOnlyPropertyQuickFix" xml:space="preserve">
574574
<value>Add property get</value>
575575
</data>
576576
<data name="ModuleScopeDimKeywordInspectionMeta" xml:space="preserve">
577-
<value>The 'Public' keyword can only be used at module level; its counterpart 'Private' can also only be used at module level. 'Dim' however, can be used to declare both procedure and module scope variables. For consistency, it would be preferable to reserve 'Dim' for locals, and thus to use 'Private' instead of 'Dim' at module level.</value>
577+
<value>Das Schlüsselwort 'Public' kann nur auf Modulebene verwendet werden; Sein Konterpart 'Private' kann auch nur auf Modulebene verwendet werden. 'Dim' jedoch kann verwendet werden, um sowohl modulweite als auch prozedurweite Variablen zu deklarieren. Um der Konsistenz Willen ist es besser, 'Dim' nur für lokale Variablen zu verwenden, also 'Private' statt 'Dim' auf Modulebene zu verwenden.</value>
578578
</data>
579579
<data name="ChangeDimToPrivateQuickFix" xml:space="preserve">
580-
<value>Replace 'Dim' with 'Private'</value>
580+
<value>'Dim' durch 'Private' ersetzen</value>
581581
</data>
582582
<data name="UndeclaredVariableInspectionName" xml:space="preserve">
583-
<value>Undeclared variable</value>
583+
<value>Nicht deklarierte Variable</value>
584584
</data>
585585
<data name="ModuleScopeDimKeywordInspectionName" xml:space="preserve">
586-
<value>Use of 'Dim' keyword at module level</value>
586+
<value>Verwendung von 'Dim' auf Modulebene</value>
587587
</data>
588588
<data name="UndeclaredVariableInspectionResultFormat" xml:space="preserve">
589-
<value>Local variable '{0}' is not declared</value>
589+
<value>Die lokale Variable '{0}' wurde nicht deklariert</value>
590590
</data>
591591
<data name="ModuleScopeDimKeywordInspectionResultFormat" xml:space="preserve">
592-
<value>Module-level variable '{0}' is declared with the 'Dim' keyword.</value>
592+
<value>Die Modulvariable '{0}' ist mit dem 'Dim'-Schlüsselwort deklariert.</value>
593593
</data>
594-
</root>
594+
</root>

Rubberduck.Parsing/Rubberduck.Parsing.csproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -129,6 +129,7 @@
129129
<Compile Include="Preprocessing\VBADateListener.cs" />
130130
<Compile Include="Preprocessing\VBADateParser.cs" />
131131
<Compile Include="Preprocessing\VBADateVisitor.cs" />
132+
<Compile Include="Symbols\SpecialFormDeclarations.cs" />
132133
<Compile Include="Symbols\ComInformation.cs" />
133134
<Compile Include="Symbols\CommentNode.cs" />
134135
<Compile Include="Symbols\ComParameter.cs" />

Rubberduck.Parsing/Symbols/DebugDeclarations.cs

Lines changed: 1 addition & 181 deletions
Original file line numberDiff line numberDiff line change
@@ -34,13 +34,7 @@ public IReadOnlyList<Declaration> Load()
3434
return new List<Declaration>();
3535
}
3636

37-
var informationModule = _finder.FindStdModule("Information", vba, true);
38-
Debug.Assert(informationModule != null, "We expect the information module to exist in the VBA project.");
39-
40-
var debugDeclarations = LoadDebugDeclarations(vba);
41-
var specialFormDeclarations = LoadSpecialFormDeclarations(informationModule);
42-
43-
return debugDeclarations.Concat(specialFormDeclarations).ToList();
37+
return LoadDebugDeclarations(vba);
4438
}
4539

4640
private static bool ThereIsAGlobalBuiltInErrVariableDeclaration(DeclarationFinder finder)
@@ -161,179 +155,5 @@ private static SubroutineDeclaration DebugPrintDeclaration(ClassModuleDeclaratio
161155
new Attributes());
162156
}
163157

164-
165-
private List<Declaration> LoadSpecialFormDeclarations(Declaration parentModule)
166-
{
167-
Debug.Assert(parentModule != null);
168-
169-
var arrayFunction = ArrayFunction(parentModule);
170-
var inputFunction = InputFunction(parentModule);
171-
var inputBFunction = InputBFunction(parentModule);
172-
var lboundFunction = LBoundFunction(parentModule);
173-
var uboundFunction = UBoundFunction(parentModule);
174-
175-
return new List<Declaration> {
176-
arrayFunction,
177-
inputFunction,
178-
inputBFunction,
179-
lboundFunction,
180-
uboundFunction
181-
};
182-
}
183-
184-
private static FunctionDeclaration ArrayFunction(Declaration parentModule)
185-
{
186-
return new FunctionDeclaration(
187-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Array"),
188-
parentModule,
189-
parentModule,
190-
"Variant",
191-
null,
192-
null,
193-
Accessibility.Public,
194-
null,
195-
Selection.Home,
196-
false,
197-
true,
198-
null,
199-
new Attributes());
200-
}
201-
202-
private static SubroutineDeclaration InputFunction(Declaration parentModule)
203-
{
204-
var inputFunction = InputFunctionWithoutParameters(parentModule);
205-
inputFunction.AddParameter(NumberParameter(parentModule, inputFunction));
206-
inputFunction.AddParameter(FileNumberParameter(parentModule, inputFunction));
207-
return inputFunction;
208-
}
209-
210-
private static SubroutineDeclaration InputFunctionWithoutParameters(Declaration parentModule)
211-
{
212-
return new SubroutineDeclaration(
213-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Input"),
214-
parentModule,
215-
parentModule,
216-
"Variant",
217-
Accessibility.Public,
218-
null,
219-
Selection.Home,
220-
true,
221-
null,
222-
new Attributes());
223-
}
224-
225-
private static ParameterDeclaration NumberParameter(Declaration parentModule, SubroutineDeclaration ParentSubroutine)
226-
{
227-
return new ParameterDeclaration(
228-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Number"),
229-
ParentSubroutine,
230-
"Integer",
231-
null,
232-
null,
233-
false,
234-
false);
235-
}
236-
237-
private static ParameterDeclaration FileNumberParameter(Declaration parentModule, SubroutineDeclaration ParentSubroutine)
238-
{
239-
return new ParameterDeclaration(
240-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Filenumber"),
241-
ParentSubroutine,
242-
"Integer",
243-
null,
244-
null,
245-
false,
246-
false);
247-
}
248-
249-
private static SubroutineDeclaration InputBFunction(Declaration parentModule)
250-
{
251-
var inputBFunction = InputBFunctionWithoutParameters(parentModule);
252-
inputBFunction.AddParameter(NumberParameter(parentModule, inputBFunction));
253-
inputBFunction.AddParameter(FileNumberParameter(parentModule, inputBFunction));
254-
return inputBFunction;
255-
}
256-
257-
private static SubroutineDeclaration InputBFunctionWithoutParameters(Declaration parentModule)
258-
{
259-
return new SubroutineDeclaration(
260-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "InputB"),
261-
parentModule,
262-
parentModule,
263-
"Variant",
264-
Accessibility.Public,
265-
null,
266-
Selection.Home,
267-
true,
268-
null,
269-
new Attributes());
270-
}
271-
272-
273-
private static FunctionDeclaration LBoundFunction(Declaration parentModule)
274-
{
275-
var lboundFunction = LBoundFunctionWithoutParameters(parentModule);
276-
lboundFunction.AddParameter(ArrayNameParameter(parentModule, lboundFunction));
277-
lboundFunction.AddParameter(DimensionParameter(parentModule, lboundFunction));
278-
return lboundFunction;
279-
}
280-
281-
private static FunctionDeclaration LBoundFunctionWithoutParameters(Declaration parentModule)
282-
{
283-
return new FunctionDeclaration(
284-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "LBound"),
285-
parentModule,
286-
parentModule,
287-
"Long",
288-
null,
289-
null,
290-
Accessibility.Public,
291-
null,
292-
Selection.Home,
293-
false,
294-
true,
295-
null,
296-
new Attributes());
297-
}
298-
299-
private static ParameterDeclaration ArrayNameParameter(Declaration parentModule, FunctionDeclaration parentFunction)
300-
{
301-
var arrayParam = new ParameterDeclaration(new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Arrayname"), parentFunction, "Variant", null, null, false, false, true);
302-
return arrayParam;
303-
}
304-
305-
private static ParameterDeclaration DimensionParameter(Declaration parentModule, FunctionDeclaration parentFunction)
306-
{
307-
var rankParam = new ParameterDeclaration(new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "Dimension"), parentFunction, "Long", null, null, true, false);
308-
return rankParam;
309-
}
310-
311-
312-
private static FunctionDeclaration UBoundFunction(Declaration parentModule)
313-
{
314-
var uboundFunction = UBoundFunctionWithoutParameters(parentModule);
315-
uboundFunction.AddParameter(ArrayNameParameter(parentModule, uboundFunction));
316-
uboundFunction.AddParameter(DimensionParameter(parentModule, uboundFunction));
317-
return uboundFunction;
318-
}
319-
320-
private static FunctionDeclaration UBoundFunctionWithoutParameters(Declaration parentModule)
321-
{
322-
return new FunctionDeclaration(
323-
new QualifiedMemberName(parentModule.QualifiedName.QualifiedModuleName, "UBound"),
324-
parentModule,
325-
parentModule,
326-
"Long",
327-
null,
328-
null,
329-
Accessibility.Public,
330-
null,
331-
Selection.Home,
332-
false,
333-
true,
334-
null,
335-
new Attributes());
336-
}
337-
338158
}
339159
}

0 commit comments

Comments
 (0)