Skip to content

Commit

Permalink
Merge pull request #4961 from retailcoder/docs
Browse files Browse the repository at this point in the history
Adds detailed xml-docs to all inspections; adds roslyn analyzers to ensure all inspections have xml-doc that the website can consume.
  • Loading branch information
retailcoder committed May 17, 2019
2 parents 6134c87 + 2ec82ec commit b909bbb
Show file tree
Hide file tree
Showing 101 changed files with 7,256 additions and 135 deletions.
Expand Up @@ -31,7 +31,7 @@ protected IReadOnlyList<Declaration> IsMissingDeclarations

if (isMissing.Count == 0)
{
_logger.Trace("No 'IsMissing' Declarations were not found in IsMissingInspectionBase.");
_logger.Trace("No 'IsMissing' Declarations were found in IsMissingInspectionBase.");
}

return isMissing;
Expand Down
Expand Up @@ -10,6 +10,32 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Warns about parameters passed by value being assigned a new value in the body of a procedure.
/// </summary>
/// <why>
/// Debugging is easier if the procedure's initial state is preserved and accessible anywhere within its scope.
/// Mutating the inputs destroys the initial state, and makes the intent ambiguous: if the calling code is meant
/// to be able to access the modified values, then the parameter should be passed ByRef; the ByVal modifier might be a bug.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// foo = foo + 1 ' is the caller supposed to see the updated value?
/// Debug.Print foo
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim bar As Long
/// bar = foo
/// bar = bar + 1 ' clearly a local copy of the original value.
/// Debug.Print bar
/// End Sub
/// ]]>
/// </example>
public sealed class AssignedByValParameterInspection : InspectionBase
{
public AssignedByValParameterInspection(RubberduckParserState state)
Expand Down
Expand Up @@ -12,6 +12,30 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Warns about a variable that is assigned, and then re-assigned before the first assignment is read.
/// </summary>
/// <why>
/// The first assignment is likely redundant, since it is being overwritten by the second.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim foo As Long
/// foo = 12 ' assignment is redundant
/// foo = 34
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim bar As Long
/// bar = 12
/// bar = bar + foo ' variable is re-assigned, but the prior assigned value is read at least once first.
/// End Sub
/// ]]>
/// </example>
public sealed class AssignmentNotUsedInspection : InspectionBase
{
private readonly Walker _walker;
Expand Down
Expand Up @@ -13,6 +13,31 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Indicates that the value of a hidden VB attribute is out of sync with the corresponding Rubberduck annotation comment.
/// </summary>
/// <why>
/// Keeping Rubberduck annotation comments in sync with the hidden VB attribute values, surfaces these hidden attributes in the VBE code panes;
/// Rubberduck can rewrite the attributes to match the corresponding annotation comment.
/// </why>
/// <example>
/// <![CDATA[
/// '@Description("foo")
/// Public Sub DoSomething()
/// Attribute VB_Description = "bar"
/// ' ...
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// '@Description("foo")
/// Public Sub DoSomething()
/// Attribute VB_Description = "foo"
/// ' ...
/// End Sub
/// ]]>
/// </example>
[CannotAnnotate]
public sealed class AttributeValueOutOfSyncInspection : InspectionBase
{
Expand Down
Expand Up @@ -13,6 +13,30 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Identifies redundant Boolean expressions in conditionals.
/// </summary>
/// <why>
/// A Boolean expression never needs to be compared to a Boolean literal in a conditional expression.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo = True Then ' foo is known to already be a Boolean value.
/// ' ...
/// End If
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
/// ' ...
/// End If
/// End Sub
/// ]]>
/// </example>
public sealed class BooleanAssignedInIfElseInspection : ParseTreeInspectionBase
{
public BooleanAssignedInIfElseInspection(RubberduckParserState state)
Expand Down
Expand Up @@ -13,6 +13,30 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Locates 'Const' declarations that are never referenced.
/// </summary>
/// <why>
/// Declarations that are never used should be removed.
/// </why>
/// <example>
/// <![CDATA[
/// Private Const foo As Long = 42
///
/// Public Sub DoSomething()
/// ' no reference to 'foo' anywhere...
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Private Const foo As Long = 42
///
/// Public Sub DoSomething()
/// Debug.Print foo
/// End Sub
/// ]]>
/// </example>
public sealed class ConstantNotUsedInspection : InspectionBase
{
public ConstantNotUsedInspection(RubberduckParserState state)
Expand Down
Expand Up @@ -14,6 +14,23 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Warns about Def[Type] statements.
/// </summary>
/// <why>
/// These declarative statements make the first letter of identifiers determine the data type.
/// </why>
/// <example>
/// <![CDATA[
/// DefBool B
/// DefDbl D
///
/// Public Sub DoSomething()
/// Dim bar ' implicit Boolean
/// ' ...
/// End Sub
/// ]]>
/// </example>
public sealed class DefTypeStatementInspection : ParseTreeInspectionBase
{
public DefTypeStatementInspection(RubberduckParserState state)
Expand Down
Expand Up @@ -9,6 +9,12 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// This inspection means to indicate when the project has not been renamed.
/// </summary>
/// <why>
/// VBA projects should be meaningfully named, to avoid namespace clashes when referencing other VBA projects.
/// </why>
[CannotAnnotate]
public sealed class DefaultProjectNameInspection : InspectionBase
{
Expand Down
Expand Up @@ -8,6 +8,31 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Warns about duplicated annotations.
/// </summary>
/// <why>
/// Rubberduck annotations should not be specified more than once for a given module, member, variable, or expression.
/// </why>
/// <example>
/// <![CDATA[
/// '@Folder("Bar")
/// '@Folder("Foo")
///
/// Public Sub DoSomething()
/// ' ...
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// '@Folder("Foo.Bar")
///
/// Public Sub DoSomething()
/// ' ...
/// End Sub
/// ]]>
/// </example>
public sealed class DuplicatedAnnotationInspection : InspectionBase
{
public DuplicatedAnnotationInspection(RubberduckParserState state) : base(state)
Expand All @@ -27,12 +52,9 @@ protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
issues.AddRange(duplicateAnnotations.Select(duplicate =>
{
var result = new DeclarationInspectionResult(
this,
string.Format(InspectionResults.DuplicatedAnnotationInspection, duplicate.Key.ToString()),
declaration);
this, string.Format(InspectionResults.DuplicatedAnnotationInspection, duplicate.Key.ToString()), declaration);
result.Properties.AnnotationType = duplicate.Key;
return result;
}));
}
Expand Down
Expand Up @@ -13,6 +13,35 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Identifies empty 'Case' blocks that can be safely removed.
/// </summary>
/// <why>
/// Case blocks in VBA do not "fall through"; an empty 'Case' block might be hiding a bug.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Select Case foo
/// Case 0 ' empty block
/// Case Is > 0
/// Debug.Print foo ' does not run if foo is 0.
/// End Select
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Select Case foo
/// Case 0
/// '...code...
/// Case Is > 0
/// '...code...
/// End Select
/// End Sub
/// ]]>
/// </example>
[Experimental(nameof(ExperimentalNames.EmptyBlockInspections))]
internal class EmptyCaseBlockInspection : ParseTreeInspectionBase
{
Expand Down
Expand Up @@ -13,6 +13,30 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Identifies empty 'Do...Loop While' blocks that can be safely removed.
/// </summary>
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Do
/// ' no executable statement...
/// Loop While foo &lt; 100
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Do
/// Debug.Print foo
/// Loop While foo &lt; 100
/// End Sub
/// ]]>
/// </example>
[Experimental(nameof(ExperimentalNames.EmptyBlockInspections))]
internal class EmptyDoWhileBlockInspection : ParseTreeInspectionBase
{
Expand All @@ -23,13 +47,11 @@ protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
{
return Listener.Contexts
.Where(result => !result.IsIgnoringInspectionResultFor(State.DeclarationFinder, AnnotationName))
.Select(result => new QualifiedContextInspectionResult(this,
InspectionResults.EmptyDoWhileBlockInspection,
result));
.Select(result =>
new QualifiedContextInspectionResult(this, InspectionResults.EmptyDoWhileBlockInspection, result));
}

public override IInspectionListener Listener { get; } =
new EmptyDoWhileBlockListener();
public override IInspectionListener Listener { get; } = new EmptyDoWhileBlockListener();

public class EmptyDoWhileBlockListener : EmptyBlockInspectionListenerBase
{
Expand Down
Expand Up @@ -13,6 +13,32 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Identifies empty 'Else' blocks that can be safely removed.
/// </summary>
/// <why>
/// Empty code blocks are redundant, dead code that should be removed. They can also be misleading about their intent:
/// an empty block may be signalling an unfinished thought or an oversight.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
/// ' ...
/// Else
/// End If
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
/// ' ...
/// End If
/// End Sub
/// ]]>
/// </example>
[Experimental(nameof(ExperimentalNames.EmptyBlockInspections))]
internal class EmptyElseBlockInspection : ParseTreeInspectionBase
{
Expand Down
Expand Up @@ -13,6 +13,32 @@

namespace Rubberduck.Inspections.Concrete
{
/// <summary>
/// Identifies empty 'For Each...Next' blocks that can be safely removed.
/// </summary>
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim sheet As Worksheet
/// For Each sheet In ThisWorkbook.Worksheets
/// ' no executable statement...
/// Next
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim sheet As Worksheet
/// For Each sheet In ThisWorkbook.Worksheets
/// Debug.Print sheet.Name
/// Next
/// End Sub
/// ]]>
/// </example>
[Experimental(nameof(ExperimentalNames.EmptyBlockInspections))]
internal class EmptyForEachBlockInspection : ParseTreeInspectionBase
{
Expand Down

0 comments on commit b909bbb

Please sign in to comment.