Skip to content

Commit

Permalink
Merge remote-tracking branch 'upstream/next' into Issue2947_ToDoHeade…
Browse files Browse the repository at this point in the history
…rReorder
  • Loading branch information
IvenBach committed Jun 25, 2019
2 parents a318245 + 4f387a2 commit b012713
Show file tree
Hide file tree
Showing 98 changed files with 655 additions and 2,962 deletions.
3 changes: 3 additions & 0 deletions .gitignore
Expand Up @@ -184,5 +184,8 @@ CodeGraphData/
/Rubberduck.Deployment/Rubberduck.API.idl
/Rubberduck.Deployment/Rubberduck.idl

# Generated Artifacts
Rubberduck.CodeAnalysis.xml

#Gradle
/.gradle/
Expand Up @@ -18,15 +18,15 @@ namespace Rubberduck.Inspections.Concrete
/// 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>
/// <example hasResults="true">
/// <![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>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim bar As Long
Expand Down
Expand Up @@ -18,7 +18,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// The first assignment is likely redundant, since it is being overwritten by the second.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim foo As Long
Expand All @@ -27,7 +27,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim bar As Long
Expand Down
Expand Up @@ -20,7 +20,7 @@ namespace Rubberduck.Inspections.Concrete
/// 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>
/// <example hasResults="true">
/// <![CDATA[
/// '@Description("foo")
/// Public Sub DoSomething()
Expand All @@ -29,7 +29,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// '@Description("foo")
/// Public Sub DoSomething()
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// A Boolean expression never needs to be compared to a Boolean literal in a conditional expression.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo = True Then ' foo is known to already be a Boolean value.
Expand All @@ -28,7 +28,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Declarations that are never used should be removed.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Private Const foo As Long = 42
///
Expand All @@ -28,7 +28,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Private Const foo As Long = 42
///
Expand Down
Expand Up @@ -20,7 +20,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// These declarative statements make the first letter of identifiers determine the data type.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// DefBool B
/// DefDbl D
Expand Down
Expand Up @@ -14,7 +14,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Rubberduck annotations should not be specified more than once for a given module, member, variable, or expression.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// '@Folder("Bar")
/// '@Folder("Foo")
Expand All @@ -24,7 +24,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// '@Folder("Foo.Bar")
///
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Case blocks in VBA do not "fall through"; an empty 'Case' block might be hiding a bug.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Select Case foo
Expand All @@ -30,7 +30,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Select Case foo
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Do
Expand All @@ -28,7 +28,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Do
Expand Down
Expand Up @@ -20,7 +20,7 @@ namespace Rubberduck.Inspections.Concrete
/// 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>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
Expand All @@ -30,7 +30,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim sheet As Worksheet
Expand All @@ -29,7 +29,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething()
/// Dim sheet As Worksheet
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim i As Long
Expand All @@ -29,7 +29,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// Dim i As Long
Expand Down
Expand Up @@ -21,7 +21,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Conditional expression is inverted; there would not be a need for an 'Else' block otherwise.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If foo Then
Expand All @@ -31,7 +31,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Boolean)
/// If Not foo Then
Expand Down
Expand Up @@ -21,7 +21,7 @@ namespace Rubberduck.Inspections.Concrete
/// While the memory gain is meaningless, an empty string literal still takes up 2 bytes of memory,
/// but 'vbNullString' is a null string pointer, and doesn't.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As String)
/// If foo = "" Then
Expand All @@ -30,7 +30,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As String)
/// If foo = vbNullString Then
Expand Down
Expand Up @@ -19,7 +19,7 @@ namespace Rubberduck.Inspections.Concrete
/// <why>
/// Dead code should be removed. A loop without a body is usually redundant.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// While foo < 100
Expand All @@ -28,7 +28,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Sub DoSomething(ByVal foo As Long)
/// While foo < 100
Expand Down
Expand Up @@ -17,12 +17,12 @@ namespace Rubberduck.Inspections.Concrete
/// Instance fields are the implementation details of a object's internal state; exposing them directly breaks encapsulation.
/// Often, an object only needs to expose a 'Get' procedure to expose an internal instance field.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Foo As Long
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Private internalFoo As Long
///
Expand Down
Expand Up @@ -17,18 +17,18 @@ namespace Rubberduck.Inspections.Concrete
/// </summary>
/// <reference name="Excel" />
/// <why>
/// An early-bound, equivalent function likely exists in the object returned by the Application.WorksheetFunction property;
/// late-bound member calls will fail at run-time with error 438 if there is a typo (a typo fails to compile for an early-bound member call).
/// Late-bound worksheet functions will return a Variant/Error given invalid inputs;
/// the equivalent early-bound member calls raise a more VB-idiomatic runtime error given the same invalid inputs.
/// A Variant/Error value cannot be coerced into any other data type, be it for assignment or comparison.
/// Trying to compare or assign a Variant/Error to another data type will throw error 13 "type mismatch" at run-time.
/// Consider using the early-bound equivalent function instead.
/// An early-bound, equivalent function exists in the object returned by the Application.WorksheetFunction property;
/// late-bound member calls will fail at run-time with error 438 if there is a typo (a typo fails to compile for an early-bound member call);
/// given invalid inputs, these late-bound member calls return a Variant/Error value that cannot be coerced into another type.
/// The equivalent early-bound member calls raise a more VB-idiomatic, trappable runtime error given the same invalid inputs:
/// trying to compare or assign a Variant/Error to another data type will throw error 13 "type mismatch" at run-time.
/// A Variant/Error value cannot be coerced into any other data type, be it for assignment or comparison.
///
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Private Sub Example()
/// Debug.Print Application.Sum(Array(1, 2, 3), 4, 5, "ABC") ' outputs "Error 2015"
/// Debug.Print Application.Sum(Array(1, 2, 3), 4, 5, "ABC") ' outputs "Error 2015" (no run-time error is raised).
///
/// Dim foo As Long
/// foo = Application.Sum(Array(1, 2, 3), 4, 5, "ABC") ' error 13 "type mismatch". Variant/Error can't be coerced to Long.
Expand All @@ -39,16 +39,16 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Private Sub Example()
/// Debug.Print Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") ' throws error 1004
/// Debug.Print Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") ' raises error 1004
///
/// Dim foo As Long
/// foo = Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") ' throws error 1004
/// foo = Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") ' raises error 1004
///
/// If Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") > 15 Then ' throws error 1004
/// ' won't run, error 1004 is thrown when "ABC" is processed by WorksheetFunction.Sum, before it returns.
/// If Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") > 15 Then ' raises error 1004
/// ' won't run, error 1004 is raised when "ABC" is processed by WorksheetFunction.Sum, before it returns.
/// End If
/// End Sub
/// ]]>
Expand Down
Expand Up @@ -15,7 +15,7 @@ namespace Rubberduck.Inspections.Concrete
/// Range.Find methods return a Range object reference that refers to the cell containing the search string;
/// this object reference will be Nothing if the search didn't turn up any results, and a member call against Nothing will raise run-time error 91.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Private Sub Example()
/// Dim foo As Range
Expand All @@ -27,7 +27,7 @@ namespace Rubberduck.Inspections.Concrete
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Private Sub Example()
/// Dim foo As Range
Expand Down
Expand Up @@ -21,13 +21,13 @@ namespace Rubberduck.Inspections.Inspections.Concrete
/// Another good reason to avoid numeric suffixes: if the function is meant to be used as a UDF in a cell formula,
/// the worksheet cell by the same name takes precedence and gets the reference, and the function is never invoked.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Public Function FOO1234()
/// End Function
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Public Function Foo()
/// End Function
Expand Down
Expand Up @@ -20,15 +20,15 @@ namespace Rubberduck.Inspections.Concrete
/// is more robust, and will be less likely to throw run-time error 1004 or produce unexpected results
/// when the active sheet isn't the expected one.
/// </why>
/// <example>
/// <example hasResults="true">
/// <![CDATA[
/// Private Sub Example()
/// Dim foo As Range
/// Set foo = Sheet1.Range(Cells(1, 1), Cells(1, 10)) ' Worksheet.Cells implicitly from ActiveSheet; error 1004 if that isn't Sheet1.
/// End Sub
/// ]]>
/// </example>
/// <example>
/// <example hasResults="false">
/// <![CDATA[
/// Private Sub Example()
/// Dim foo As Range
Expand Down

0 comments on commit b012713

Please sign in to comment.