diff --git a/Dictionary.cls b/Dictionary.cls index 07d3a5a..86929c1 100644 --- a/Dictionary.cls +++ b/Dictionary.cls @@ -292,12 +292,12 @@ Private Sub dict_AddKeyValue(dict_Key As Variant, dict_Value As Variant, Optiona dict_pItems(dict_Index - 1) = dict_Value End If - dict_pKeyValues.Add Array(dict_FormattedKey, dict_Key, dict_Value), dict_FormattedKey, Before:=Index + dict_pKeyValues.Add Array(dict_FormattedKey, dict_Key, dict_Value), dict_FormattedKey, Before:=dict_Index Else - If VBA.IsObject(Key) Then - Set pKeys(UBound(pKeys)) = Key + If VBA.IsObject(dict_Key) Then + Set dict_pKeys(UBound(dict_pKeys)) = dict_Key Else - pKeys(UBound(pKeys)) = Key + dict_pKeys(UBound(dict_pKeys)) = dict_Key End If If VBA.IsObject(dict_Value) Then Set dict_pItems(UBound(dict_pItems)) = dict_Value @@ -313,12 +313,7 @@ Private Sub dict_ReplaceKeyValue(dict_KeyValue As Variant, dict_Key As Variant, Dim dict_Index As Long Dim dict_i As Integer - For dict_i = 0 To UBound(dict_pKeys) - If dict_pKeys(dict_i) = dict_KeyValue(1) Then - dict_Index = dict_i + 1 - Exit For - End If - Next dict_i + dict_Index = dict_GetKeyIndex(dict_KeyValue(1)) ' Remove existing dict_Value dict_RemoveKeyValue dict_KeyValue, dict_Index @@ -330,11 +325,7 @@ End Sub Private Sub dict_RemoveKeyValue(dict_KeyValue As Variant, Optional ByVal dict_Index As Long = -1) Dim dict_i As Long If dict_Index = -1 Then - For dict_i = 0 To UBound(dict_pKeys) - If dict_pKeys(dict_i) = dict_KeyValue(1) Then - dict_Index = dict_i - End If - Next dict_i + dict_Index = dict_GetKeyIndex(dict_KeyValue(1)) Else dict_Index = dict_Index - 1 End If @@ -359,8 +350,8 @@ Private Sub dict_RemoveKeyValue(dict_KeyValue As Variant, Optional ByVal dict_In End If End If - pKeyValues.Remove KeyValue(0) - dict_RemoveObjectKey KeyValue(1) + dict_pKeyValues.Remove dict_KeyValue(0) + dict_RemoveObjectKey dict_KeyValue(1) End Sub Private Function dict_GetFormattedKey(dict_Key As Variant) As String @@ -390,7 +381,7 @@ Private Function dict_GetFormattedKey(dict_Key As Variant) As String Else dict_Lowercase = dict_Lowercase & "_" End If - Next i + Next dict_i If dict_Lowercase <> "" Then dict_GetFormattedKey = dict_GetFormattedKey & "__" & dict_Lowercase @@ -427,6 +418,23 @@ Private Sub dict_RemoveObjectKey(dict_ObjKey As Variant) Next dict_i End Sub +Private Function dict_GetKeyIndex(dict_Key As Variant) As Long + Dim dict_i As Long + For dict_i = 0 To UBound(dict_pKeys) + If VBA.IsObject(dict_pKeys(dict_i)) And VBA.IsObject(dict_Key) Then + If dict_pKeys(dict_i) Is dict_Key Then + dict_GetKeyIndex = dict_i + Exit For + End If + ElseIf VBA.IsObject(dict_pKeys(dict_i)) Or VBA.IsObject(dict_Key) Then + ' Both need to be objects to check equality, skip + ElseIf dict_pKeys(dict_i) = dict_Key Then + dict_GetKeyIndex = dict_i + Exit For + End If + Next dict_i +End Function + #End If Private Sub Class_Initialize() diff --git a/specs/Specs.bas b/specs/Specs.bas index 425d336..95f4fdd 100644 --- a/specs/Specs.bas +++ b/specs/Specs.bas @@ -1,16 +1,32 @@ Attribute VB_Name = "Specs" -Public Function Specs() As SpecSuite +Private pForDisplay As Boolean +Private pUseNative As Boolean + +Public Sub SpeedTest() #If Mac Then ' Mac - InlineRunner.RunSuite AllSpecs(UseNative:=False) - SpeedTest CompareToNative:=False + ExecuteSpeedTest CompareToNative:=False #Else ' Windows - InlineRunner.RunSuite AllSpecs(UseNative:=True) - InlineRunner.RunSuite AllSpecs(UseNative:=False) - SpeedTest CompareToNative:=True + ExecuteSpeedTest CompareToNative:=True #End If -End Function +End Sub + +Sub ToggleNative(Optional Enabled As Boolean = True) + Dim Code As CodeModule + Dim Lines As Variant + Dim i As Integer + + Set Code = ThisWorkbook.VBProject.VBComponents("Dictionary").CodeModule + Lines = Split(Code.Lines(1, 50), vbNewLine) + + For i = 0 To UBound(Lines) + If InStr(1, Lines(i), "#Const UseScriptingDictionaryIfAvailable") Then + Code.ReplaceLine i + 1, "#Const UseScriptingDictionaryIfAvailable = " & Enabled + Exit Sub + End If + Next i +End Sub Public Sub RunSpecs() DisplayRunner.IdCol = 1 @@ -18,11 +34,32 @@ Public Sub RunSpecs() DisplayRunner.ResultCol = 2 DisplayRunner.OutputStartRow = 4 - DisplayRunner.RunSuite AllSpecs(UseNative:=False) + pForDisplay = True + DisplayRunner.RunSuite Specs() + pForDisplay = False End Sub -Public Function AllSpecs(Optional UseNative As Boolean = False) As SpecSuite - Dim Specs As New SpecSuite +Public Function Specs() As SpecSuite + Dim UseNative As Boolean + +#If Mac Then + UseNative = False +#Else + If pUseNative Then + UseNative = True + pUseNative = False + Else + If Not pForDisplay Then + ' Run native specs first + pUseNative = True + Specs + End If + + UseNative = False + End If +#End If + + Set Specs = New SpecSuite If UseNative Then Specs.Description = "Scripting.Dictionary" Else @@ -34,6 +71,8 @@ Public Function AllSpecs(Optional UseNative As Boolean = False) As SpecSuite Dim Keys As Variant Dim Key As Variant Dim Item As Variant + Dim A As New Collection + Dim B As New Dictionary ' Properties ' ------------------------- ' @@ -175,10 +214,10 @@ Public Function AllSpecs(Optional UseNative As Boolean = False) As SpecSuite With Specs.It("should handle object keys") Set Dict = CreateDictionary(UseNative) - Dim A As New Collection - A.Add 123 + Set A = New Collection + Set B = New Dictionary - Dim B As New Dictionary + A.Add 123 B.Add "a", 456 Dict.Add A, "123" @@ -418,11 +457,10 @@ Public Function AllSpecs(Optional UseNative As Boolean = False) As SpecSuite End With On Error GoTo 0 - - Set AllSpecs = Specs + InlineRunner.RunSuite Specs End Function -Public Sub SpeedTest(Optional CompareToNative As Boolean = False) +Public Sub ExecuteSpeedTest(Optional CompareToNative As Boolean = False) Dim Counts As Variant Counts = Array(5000, 5000, 5000, 5000, 7500, 7500, 7500, 7500) diff --git a/specs/VBA-Dictionary - Specs.xlsm b/specs/VBA-Dictionary - Specs.xlsm index 6b691bb..560c148 100644 Binary files a/specs/VBA-Dictionary - Specs.xlsm and b/specs/VBA-Dictionary - Specs.xlsm differ