fix error messages for UDT's.

create release version 5.0.4.
kellyethridge · Jul 21, 2019 · a7001f7 · a7001f7
1 parent c053c2e
commit a7001f7
Show file tree

Hide file tree

Showing 11 changed files with 205 additions and 90 deletions.
diff --git a/Binaries/Compiled/SimplyVBUnit.Component.ocx b/Binaries/Compiled/SimplyVBUnit.Component.ocx
diff --git a/Binaries/Compiled/SimplyVBUnit.Component.pdb b/Binaries/Compiled/SimplyVBUnit.Component.pdb
diff --git a/Binaries/Compiled/SimplyVBUnit.Framework.dll b/Binaries/Compiled/SimplyVBUnit.Framework.dll
diff --git a/Binaries/Compiled/SimplyVBUnit.Framework.pdb b/Binaries/Compiled/SimplyVBUnit.Framework.pdb
diff --git a/Install/InstallScript.iss b/Install/InstallScript.iss
@@ -6,8 +6,8 @@
 ; Do not use the same AppId value in installers for other applications.
 ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
 AppId={{249D663E-A119-4D35-A0F4-15821B9416E5}
-AppName=SimplyVBUnit 5.0.3
-AppVerName=SimplyVBUnit 5.0.3
+AppName=SimplyVBUnit 5.0.4
+AppVerName=SimplyVBUnit 5.0.4
 AppPublisher=Kelly Ethridge
 AppPublisherURL=https://sourceforge.net/projects/simplyvbunit/
 AppSupportURL=https://sourceforge.net/projects/simplyvbunit/
@@ -16,7 +16,7 @@ DefaultDirName={pf}\SimplyVBUnit 5.0
 DefaultGroupName=SimplyVBUnit 5.0
 AllowNoIcons=yes
 OutputDir=.
-OutputBaseFilename=SimplyVBUnitSetup-5.0.3
+OutputBaseFilename=SimplyVBUnitSetup-5.0.4
 Compression=lzma
 SolidCompression=yes
 

diff --git a/Source/Fakes/FakeTypes.cls b/Source/Fakes/FakeTypes.cls
@@ -21,14 +21,18 @@ End Type
 Public Type ComplexType
     Value1 As Long
     Simple1 As SimpleType
+    FixedLong(100) As Long
+    FixedSimples(50) As SimpleType
+    DynamicSimples() As SimpleType
 End Type
 
 Public Function NewSimpleType(ByVal Value1 As Long, ByVal Value2 As String) As SimpleType
     NewSimpleType.Value1 = Value1
     NewSimpleType.Value2 = Value2
 End Function
 
-Public Function NewComplexType(ByVal Value1 As Long, ByRef Simple1 As SimpleType) As ComplexType
+Public Function NewComplexType(ByVal Value1 As Long, ByRef Simple1 As SimpleType, Optional ByVal FixedLong As Long) As ComplexType
     NewComplexType.Value1 = Value1
     NewComplexType.Simple1 = Simple1
+    NewComplexType.FixedLong(75) = FixedLong
 End Function
diff --git a/Source/Framework/EqualConstraint.cls b/Source/Framework/EqualConstraint.cls
@@ -188,10 +188,7 @@ Private Sub DisplayCollectionDifferences(ByRef Expected As Variant, ByRef Actual
 
     If mComparer.FailurePoints.Count > 0 Then
         Set Failure = mComparer.FailurePoints.Pop
-        Dim Index As Long
-        Index = Failure.Position
-
-        DisplayCollectionFailurePoint Expected, Actual, Writer, Index, Indent
+        DisplayCollectionFailurePoint Expected, Actual, Writer, Failure.Position, Indent
 
         If mComparer.FailurePoints.Count > 0 Then
             DisplayCollectionDifferences Failure.Expected, Failure.Actual, Writer, Indent + 2
@@ -206,17 +203,19 @@ Private Sub DisplayCollectionDifferences(ByRef Expected As Variant, ByRef Actual
             If ExpectedCount < ActualCount Then
                 ' too many
                 Writer.WriteText "  Extra: "
-                Writer.WriteCollectionElements Actual, Index, 3
+                Writer.WriteCollectionElements Actual, Failure.Position, 3
                 Writer.WriteLine
 
             ElseIf ExpectedCount > ActualCount Then
                 ' too few
                 Writer.WriteText "  Missing: "
-                Writer.WriteCollectionElements Expected, Index, 3
+                Writer.WriteCollectionElements Expected, Failure.Position, 3
                 Writer.WriteLine
             Else
                 Writer.DisplayDifferences Failure.Expected, Failure.Actual
             End If
+        ElseIf VarType(Failure.Expected) = vbUserDefinedType And VarType(Failure.Actual) = vbUserDefinedType Then
+            DisplayUDTDifference Writer, Failure.Expected, Failure.Actual
         Else
             Writer.DisplayDifferences Failure.Expected, Failure.Actual
         End If
@@ -253,12 +252,11 @@ Private Sub AppendElementCountInfo(ByRef Value As Variant, ByRef s As String)
 End Sub
 
 Private Sub DisplayCollectionFailurePoint(ByRef Expected As Variant, ByRef Actual As Variant, ByVal Writer As TextMessageWriter, ByVal Index As Long, ByVal Indent As Long)
-    Writer.WriteText Space$(Indent)
-
     Dim ExpectedIndices As String
-    ExpectedIndices = MsgUtils.GetArrayIndicesAsString(MsgUtils.GetArrayIndicesFromCollectionIndex(Expected, Index))
-
     Dim ActualIndices As String
+
+    Writer.WriteText Space$(Indent)
+    ExpectedIndices = MsgUtils.GetArrayIndicesAsString(MsgUtils.GetArrayIndicesFromCollectionIndex(Expected, Index))
     ActualIndices = MsgUtils.GetArrayIndicesAsString(MsgUtils.GetArrayIndicesFromCollectionIndex(Actual, Index))
 
     If ExpectedIndices = ActualIndices Then
@@ -268,72 +266,18 @@ Private Sub DisplayCollectionFailurePoint(ByRef Expected As Variant, ByRef Actua
     End If
 End Sub
 
-
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   Class Events
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-Private Sub Class_Initialize()
-    mClipping = DEF_CLIPPING
-End Sub
-
-
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   IBasicExpression Interface
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-Private Function IBasicExpression_AndAlso() As SimplyVBUnitType.IConstraintExpression
-    Set IBasicExpression_AndAlso = mExpression.AndAlso
-End Function
-
-Private Function IBasicExpression_OrElse() As SimplyVBUnitType.IConstraintExpression
-    Set IBasicExpression_OrElse = mExpression.OrElse
-End Function
-
-
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   IConstraint Interface
-'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-Private Function IConstraint_Matches(Actual As Variant) As Boolean
-    IConstraint_Matches = Matches(Actual)
-End Function
-
-Private Sub IConstraint_WriteActualValueTo(ByVal Writer As TextMessageWriter)
-    Writer.WriteActualValue mActual
-End Sub
-
-Private Sub IConstraint_WriteDescriptionTo(ByVal Writer As TextMessageWriter)
-    Writer.WriteExpectedValue mExpected
-End Sub
-
-Private Sub IConstraint_WriteMessageTo(ByVal Writer As TextMessageWriter)
-    If IsEnumerable(mExpected) And IsEnumerable(mActual) Then
-        DisplayCollectionDifferences mExpected, mActual, Writer, 0
-    ElseIf VarType(mActual) = vbString And VarType(mExpected) = vbString Then
-        DisplayStringDifferences Writer, mExpected, mActual
-    ElseIf VarType(mExpected) = vbUserDefinedType Then
-        WriteUDTMessage Writer
-    ElseIf VarType(mActual) = vbUserDefinedType Then
-        WriteUDTTypeMismatch Writer
-    Else
-        Writer.DisplayConstraintDifferences Me
-    End If
-End Sub
-
-Private Sub WriteUDTMessage(ByVal Writer As TextMessageWriter)
+Private Sub DisplayUDTDifference(ByVal Writer As TextMessageWriter, ByRef Expected As Variant, ByRef Actual As Variant)
     Dim ActualRecord    As IRecordInfo
     Dim ExpectedRecord  As IRecordInfo
 
     On Error GoTo Catch
 
-    If VarType(mActual) = vbUserDefinedType Then
-        ObjectPtr(ActualRecord) = MemLong(VarPtr(mActual) + VARIANTRECORD_OFFSET)
-        ObjectPtr(ExpectedRecord) = MemLong(VarPtr(mExpected) + VARIANTRECORD_OFFSET)
-
-        If ActualRecord.IsMatchingType(ExpectedRecord) Then
-            Writer.WriteLine "type field -> " & CreateTypeNavigationPath
-            WriteUDTExpectedAndActual Writer, mComparer.FailurePoints.Pop, mComparer.FailurePoints.Pop
-        Else
-            WriteUDTTypeMismatch Writer
-        End If
+    ObjectPtr(ActualRecord) = MemLong(VarPtr(Actual) + VARIANTRECORD_OFFSET)
+    ObjectPtr(ExpectedRecord) = MemLong(VarPtr(Expected) + VARIANTRECORD_OFFSET)
+
+    If ActualRecord.IsMatchingType(ExpectedRecord) Then
+        Writer.WriteLine "type field -> " & CreateTypeNavigationPath
+        WriteUDTExpectedAndActual Writer, mComparer.TypePath.Pop, mComparer.TypePath.Pop
     Else
         WriteUDTTypeMismatch Writer
     End If
@@ -352,12 +296,12 @@ End Sub
 Private Function CreateTypeNavigationPath() As String
     Dim Path As String
 
-    Do While mComparer.FailurePoints.Count > 2
+    Do While mComparer.TypePath.Count > 2
         If Len(Path) > 0 Then
             Path = Path & "."
         End If
 
-        Path = Path & mComparer.FailurePoints.Pop
+        Path = Path & mComparer.TypePath.Pop
     Loop
 
     CreateTypeNavigationPath = Path
@@ -370,6 +314,8 @@ End Sub
 Private Sub WriteUDTExpectedAndActual(ByVal Writer As TextMessageWriter, ByRef Expected As Variant, ByRef Actual As Variant)
     If VarType(Expected) = vbString And VarType(Actual) = vbString Then
         DisplayStringDifferences Writer, Expected, Actual
+    ElseIf IsEnumerable(Expected) And IsEnumerable(Actual) Then
+        DisplayCollectionDifferences Expected, Actual, Writer, 0
     Else
         Writer.WriteText "  Expected: "
         Writer.WriteExpectedValue Expected
@@ -381,7 +327,61 @@ End Sub
 
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   IEqualityExpression Interface
+'   Constructors
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Private Sub Class_Initialize()
+    mClipping = DEF_CLIPPING
+End Sub
+
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'   IBasicExpression
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Private Function IBasicExpression_AndAlso() As SimplyVBUnitType.IConstraintExpression
+    Set IBasicExpression_AndAlso = mExpression.AndAlso
+End Function
+
+Private Function IBasicExpression_OrElse() As SimplyVBUnitType.IConstraintExpression
+    Set IBasicExpression_OrElse = mExpression.OrElse
+End Function
+
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'   IConstraint
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Private Function IConstraint_Matches(Actual As Variant) As Boolean
+    IConstraint_Matches = Matches(Actual)
+End Function
+
+Private Sub IConstraint_WriteActualValueTo(ByVal Writer As TextMessageWriter)
+    Writer.WriteActualValue mActual
+End Sub
+
+Private Sub IConstraint_WriteDescriptionTo(ByVal Writer As TextMessageWriter)
+    Writer.WriteExpectedValue mExpected
+End Sub
+
+Private Sub IConstraint_WriteMessageTo(ByVal Writer As TextMessageWriter)
+    If IsEnumerable(mExpected) And IsEnumerable(mActual) Then
+        DisplayCollectionDifferences mExpected, mActual, Writer, 0
+    ElseIf VarType(mActual) = vbString And VarType(mExpected) = vbString Then
+        DisplayStringDifferences Writer, mExpected, mActual
+    ElseIf VarType(mExpected) = vbUserDefinedType Then
+        If VarType(mActual) = vbUserDefinedType Then
+            DisplayUDTDifference Writer, mExpected, mActual
+        Else
+            WriteUDTTypeMismatch Writer
+        End If
+    ElseIf VarType(mActual) = vbUserDefinedType Then
+        WriteUDTTypeMismatch Writer
+    Else
+        Writer.DisplayConstraintDifferences Me
+    End If
+End Sub
+
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'   IEqualityExpression
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Private Function IEqualityExpression_AndAlso() As SimplyVBUnitType.IConstraintExpression
     Set IEqualityExpression_AndAlso = mExpression.AndAlso
@@ -417,15 +417,15 @@ End Function
 
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   IResolvable Interface
+'   IResolvable
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Private Function IResolvable_Resolve() As IConstraint
     Set IResolvable_Resolve = Resolve(Me, mExpression)
 End Function
 
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-'   IToleranceUnits Interface
+'   IToleranceUnits
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Private Function IToleranceUnits_Days() As SimplyVBUnitType.IEqualityExpression
     Set IToleranceUnits_Days = Days

diff --git a/Source/Framework/EqualityComparer.cls b/Source/Framework/EqualityComparer.cls
@@ -52,6 +52,8 @@ Private mAsCollection       As Boolean
 Private mTolerance          As Tolerance
 Private mExternalComparer   As IEqualityComparer
 Private mFailurePoints      As New Stack
+Private mTypePath           As New Stack
+Private mLevel              As Long
 
 
 Public Property Get Strict() As Boolean
@@ -99,16 +101,19 @@ Public Property Get FailurePoints() As Stack
 End Property
 
 Public Function Equals(ByRef X As Variant, ByRef Y As Variant) As Boolean
-    mFailurePoints.Clear
     Equals = EqualsCore(X, Y)
 
     If Not Equals Then
         If VarType(X) = vbUserDefinedType And VarType(Y) = vbUserDefinedType Then
-            mFailurePoints.Push TypeName(X)
+            mTypePath.Push TypeName(X)
         End If
     End If
 End Function
 
+Friend Property Get TypePath() As Stack
+    Set TypePath = mTypePath
+End Property
+
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 '   Private Helpers
@@ -341,13 +346,13 @@ Private Function EqualUdt(ByRef ObjA As Variant, ByRef ObjB As Variant) As Boole
 
             Dim i As Long
             For i = 0 To FieldNameCount - 1
-                If Not EqualsCore(ObjARecord.GetField(ObjAPtr, FieldNames(i)), ObjARecord.GetField(ObjBPtr, FieldNames(i))) Then
-                    If mFailurePoints.Count = 0 Then
-                        mFailurePoints.Push ObjARecord.GetField(ObjBPtr, FieldNames(i))
-                        mFailurePoints.Push ObjARecord.GetField(ObjAPtr, FieldNames(i))
-                    End If
-                
-                    mFailurePoints.Push FieldNames(i)
+                If Not EqualUdtCore(ObjARecord.GetField(ObjAPtr, FieldNames(i)), ObjARecord.GetField(ObjBPtr, FieldNames(i)), FieldNames(i)) Then
+'                    If mTypePath.Count = 0 Then
+'                        mTypePath.Push ObjARecord.GetField(ObjBPtr, FieldNames(i))
+'                        mTypePath.Push ObjARecord.GetField(ObjAPtr, FieldNames(i))
+'                    End If
+'
+'                    mTypePath.Push FieldNames(i)
                     GoSub Finally
                     Exit Function
                 End If
@@ -369,6 +374,33 @@ Finally:
     Return
 End Function
 
+Private Function EqualUdtCore(ByRef X As Variant, ByRef Y As Variant, ByRef FieldName As String) As Boolean
+    Dim Result As Boolean
+
+    Result = EqualsCore(X, Y)
+
+    If Not Result Then
+        If mTypePath.Count = 0 Then
+            mTypePath.Push Y
+            mTypePath.Push X
+        End If
+
+        If VarType(X) = (vbArray Or vbUserDefinedType) Then
+            Dim Point As FailurePoint
+
+            If mFailurePoints.Count > 0 Then
+                Set Point = mFailurePoints.Pop
+                mTypePath.Pop
+                mTypePath.Push FieldName & "(" & Point.Position & ")"
+            End If
+        Else
+            mTypePath.Push FieldName
+        End If
+    End If
+
+    EqualUdtCore = Result
+End Function
+
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 '   Class Events

diff --git a/Source/Framework/TextMessageWriter.cls b/Source/Framework/TextMessageWriter.cls
@@ -141,6 +141,7 @@ Public Sub WriteValue(ByRef Value As Variant)
             Case vbNull:                    WriteText FMT_NULL
             Case vbEmpty:                   WriteText FMT_EMPTY
             Case vbError:                   WriteText FMT_MISSING
+            Case vbUserDefinedType:         WriteDefault TypeName(Value)
             Case Else:                      WriteDefault Value
         End Select
     End If

diff --git a/Source/Tests/BootstrapEqualityComparerTests.cls b/Source/Tests/BootstrapEqualityComparerTests.cls
@@ -132,6 +132,11 @@ Public Function Run() As Long
     RunTest Equals_WithDefaultSettings_ReturnsExpected(NewComplexType(2, NewSimpleType(1, "hi")), NewComplexType(3, NewSimpleType(1, "hi")), False)
     RunTest Equals_WithDefaultSettings_ReturnsExpected(NewComplexType(3, NewSimpleType(1, "hi")), NewComplexType(3, NewSimpleType(1, "bye")), False)
 
+    Dim Complex As ComplexType
+    Complex = NewComplexType(3, NewSimpleType(1, "hi"))
+    ReDim Complex.DynamicSimples(1)
+    RunTest Equals_WithDefaultSettings_ReturnsExpected(Complex, NewComplexType(3, NewSimpleType(1, "hi")), False)
+
     RunTest Equals_WithStrictSettings_ReturnsExpected(0, 0, True)
     RunTest Equals_WithStrictSettings_ReturnsExpected(0&, 0, False)
     RunTest Equals_WithStrictSettings_ReturnsExpected(0, 0&, False)