Bug with For Each enumeration on x64 Custom Classes

What is happening

It appears that the stack frames are overlapping although they should not. Having enough variables in the ShowBug method prevents a crash and the values of the variables (in the caller subroutine) are simply changed because the memory they refer to is also used by another stack frame (the called subroutine) that was added/pushed later at the top of the call stack.

We can test this by adding a couple of Debug.Print statements to the same code from the question.

The CustomCollection class:

VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "CustomCollection"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseOption ExplicitPrivate m_coll As CollectionPrivate Sub Class_Initialize()    Set m_coll = New CollectionEnd SubPrivate Sub Class_Terminate()    Set m_coll = NothingEnd SubPublic Sub Add(v As Variant)    m_coll.Add vEnd SubPublic Function NewEnum() As IEnumVARIANTAttribute NewEnum.VB_UserMemId = -4    Debug.Print "The NewEnum return address " & VarPtr(NewEnum) & " should be outside of the"    Set NewEnum = m_coll.[_NewEnum]End Function

And the calling code, in a standard .bas module:

Option ExplicitSub Main()    #If Win64 Then        Dim c As New CustomCollection        c.Add 1        c.Add 2        ShowBug c    #Else        MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"    #End IfEnd SubSub ShowBug(ByRef c As CustomCollection)    Dim ptr0 As LongPtr    Dim ptr1 As LongPtr    Dim ptr2 As LongPtr    Dim ptr3 As LongPtr    Dim ptr4 As LongPtr    Dim ptr5 As LongPtr    Dim ptr6 As LongPtr    Dim ptr7 As LongPtr    Dim ptr8 As LongPtr    Dim ptr9 As LongPtr    '    Dim v As Variant    '    For Each v In c    Next v    Debug.Print VarPtr(ptr9) & " - " & VarPtr(ptr0) & " memory range"    Debug.Assert ptr0 = 0End Sub

By running Main I get something like this in the Immediate Window:

The address of the NewEnum return value is clearly at a memory address in between the ptr0 and ptr9 variables of the ShowBug method. So, that is why the variables get values out of nowhere, because they actually come from the stack frame of the NewEnum method (like the address of the object's vtable or the address of the IEnumVariant interface). If the variables would not be there, then the crash is obvious as more critical parts of memory are being overwritten (e.g. the frame pointer address for the ShowBug method). As the stack frame for the NewEnum method is larger (we can add local variables for example, to increase the size), the more memory is shared between the top stack frame and the one below in the call stack.

What happens if we workaround the bug with the options described in the question? Simply adding a Set v = Nothing before the For Each v In c line, results into:

Showing both previous value and the current one (bordered blue), we can see that the NewEnum return is at a memory address outside of the ptr0 and ptr9 variables of the ShowBug method. It seems that the stack frame was correctly allocated using the workaround.

If we break inside the NewEnum the call stack looks like this:

How For Each invokes NewEnum

Every VBA class is derived from IDispatch (which in turn is derived from IUnknown).

When a For Each... loop is called on an object, that object's IDispatch::Invoke method is called with a dispIDMember equal to -4. A VBA.Collection already has such a member but for VBA custom classes we mark our own method with Attribute NewEnum.VB_UserMemId = -4 so that Invoke can call our method.

Invoke is not called directly if the interface used in the For Each line is not derived from IDispatch. Instead, IUnknown::QueryInterface is called first and asked for the IDispatch interface. In this case Invoke is obviously calledonly after IDispatch interface is returned. Right here is the reason why using For Each on an Object declared As IUnknown will not cause the bug regardless if it is passed ByRef or if it is a global or class member custom collection. It simply uses workaround number 1 mentioned in the question (i.e. calls another method) although we cannot see it.

Hooking Invoke

We can replace the non-VB Invoke method with one of our own in order to investigate further. In a standard .bas module we need the following code to hook:

Option Explicit#If Mac Then    #If VBA7 Then        Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr    #Else        Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long    #End If#Else 'Windows    'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx    #If VBA7 Then        Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)    #Else        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)    #End If#End If#If Win64 Then    Private Const PTR_SIZE As Long = 8#Else    Private Const PTR_SIZE As Long = 4#End If#If VBA7 Then    Private newInvokePtr As LongPtr    Private oldInvokePtr As LongPtr    Private invokeVtblPtr As LongPtr#Else    Private newInvokePtr As Long    Private oldInvokePtr As Long    Private invokeVtblPtr As Long#End If'https://docs.microsoft.com/en-us/windows/win32/api/oaidl/nf-oaidl-idispatch-invokeFunction IDispatch_Invoke(ByVal this As Object _    , ByVal dispIDMember As Long _    , ByVal riid As LongPtr _    , ByVal lcid As Long _    , ByVal wFlags As Integer _    , ByVal pDispParams As LongPtr _    , ByVal pVarResult As LongPtr _    , ByVal pExcepInfo As LongPtr _    , ByRef puArgErr As Long _) As Long    Const DISP_E_MEMBERNOTFOUND = &H80020003    '    Debug.Print "The IDispatch::Invoke return address " & VarPtr(IDispatch_Invoke) & " should be outside of the"    IDispatch_Invoke = DISP_E_MEMBERNOTFOUNDEnd FunctionSub HookInvoke(obj As Object)    If obj Is Nothing Then Exit Sub    #If VBA7 Then        Dim vTablePtr As LongPtr    #Else        Dim vTablePtr As Long    #End If    '    newInvokePtr = VBA.Int(AddressOf IDispatch_Invoke)    CopyMemory vTablePtr, ByVal ObjPtr(obj), PTR_SIZE    '    invokeVtblPtr = vTablePtr + 6 * PTR_SIZE    CopyMemory oldInvokePtr, ByVal invokeVtblPtr, PTR_SIZE    CopyMemory ByVal invokeVtblPtr, newInvokePtr, PTR_SIZEEnd SubSub RestoreInvoke()    If invokeVtblPtr = 0 Then Exit Sub    '    CopyMemory ByVal invokeVtblPtr, oldInvokePtr, PTR_SIZE    invokeVtblPtr = 0    oldInvokePtr = 0    newInvokePtr = 0End Sub

and we run the Main2 method (standard .bas module) to produce the bug:

Option ExplicitSub Main2()    #If Win64 Then        Dim c As Object        Set c = New CustomCollection        c.Add 1        c.Add 2        '        HookInvoke c        ShowBug2 c        RestoreInvoke    #Else        MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"    #End IfEnd SubSub ShowBug2(ByRef c As CustomCollection)    Dim ptr00 As LongPtr    Dim ptr01 As LongPtr    Dim ptr02 As LongPtr    Dim ptr03 As LongPtr    Dim ptr04 As LongPtr    Dim ptr05 As LongPtr    Dim ptr06 As LongPtr    Dim ptr07 As LongPtr    Dim ptr08 As LongPtr    Dim ptr09 As LongPtr    Dim ptr10 As LongPtr    Dim ptr11 As LongPtr    Dim ptr12 As LongPtr    Dim ptr13 As LongPtr    Dim ptr14 As LongPtr    Dim ptr15 As LongPtr    Dim ptr16 As LongPtr    Dim ptr17 As LongPtr    Dim ptr18 As LongPtr    Dim ptr19 As LongPtr    '    Dim v As Variant    '    On Error Resume Next    For Each v In c    Next v    Debug.Print VarPtr(ptr19) & " - " & VarPtr(ptr00) & " range on the call stack"    Debug.Assert ptr00 = 0End Sub

^{Notice that more dummy ptr variables are needed to prevent the crash as the stack frame for IDispatch_Invoke is bigger (hence, the memory overlap is bigger).}

By running the above, I get:

The same bug occurs although the code never reaches the NewEnum method due to the hooking of the Invoke method. The stack frame is again wrongfully allocated.

Again, adding a Set v = Nothing before the For Each v In c results into:

The stack frame is allocated correctly (bordered green). This indicates that the issue is not with the NewEnum method and also not with our replacement Invoke method. Something is happening before our Invoke is called.

If we break inside our IDispatch_Invoke the call stack looks like this:

One last example. Consider a blank (with no code) class Class1. If we run Main3 in the following code:

Option ExplicitSub Main3()    #If Win64 Then        Dim c As New Class1        ShowBug3 c    #Else        MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"    #End IfEnd SubSub ShowBug3(ByRef c As Class1)    Dim ptr0 As LongPtr    Dim ptr1 As LongPtr    Dim ptr2 As LongPtr    Dim ptr3 As LongPtr    Dim ptr4 As LongPtr    Dim ptr5 As LongPtr    Dim ptr6 As LongPtr    Dim ptr7 As LongPtr    Dim ptr8 As LongPtr    Dim ptr9 As LongPtr    '    Dim v As Variant    '    On Error Resume Next    For Each v In c    Next v    Debug.Assert ptr0 = 0End Sub

The bug simply does not occur. How is this different from running Main2 with our own hooked Invoke? In both cases DISP_E_MEMBERNOTFOUND is returned and no NewEnum method is called.

Well, if we look at the previously shown call stacks side by side:

we can see that the non-VB Invoke is not pushed on the VB stack as a separate "Non-Basic Code" entry.

Apparently, the bug only occurs if a VBA method is called (either NewEnum via the original non-VB Invoke or our own IDispatch_Invoke). If a non-VB method is called (like the original IDispatch::Invoke with no following NewEnum) the bug does not occur as in Main3 above. No bug occurs when running For Each... on a VBA Collection within the same circumstances either.

The bug cause

As all the above examples suggest, the bug can be summarized with the following:
For Each calls IDispatch::Invoke which in turn calls NewEnum while the stack pointer has not been incremented with the size of the ShowBug stack frame. Hence, same memory is used by both frames (the caller ShowBug and the callee NewEnum).

Workarounds

Ways to force the correct incrementation of the stack pointer:

1. call another method directly (before the For Each line) e.g. Sin 1
2. call another method indirectly (before the For Each line):
   • a call to IUnknown::AddRef by passing the argument ByVal
   • a call to IUnknown::QueryInterface by using the stdole.IUnknown interface
   • using a Set statement which will call either AddRef or Release or both (e.g. Set c = c). Could also call QueryInterface depending on the source and target interfaces

As suggested in the EDIT section of the question, we don't always have the possibility to pass the Custom Collection class ByVal because it could simply be a global variable, or a class member and we would need to remember to do a dummy Set statement or to call another method before For Each... is executed.

Solution

I still could not find a better solution that the one presented in the question, so I am just going to replicate the code here as part of the answer, with a slight tweak.

EnumHelper class:

VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "EnumHelper"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseOption ExplicitPrivate m_enum As IEnumVARIANTPublic Property Set EnumVariant(newEnum_ As IEnumVARIANT)    Set m_enum = newEnum_End PropertyPublic Property Get EnumVariant() As IEnumVARIANTAttribute EnumVariant.VB_UserMemId = -4    Set EnumVariant = m_enumEnd PropertyPublic Property Get Self() As EnumHelper    Set Self = MeEnd Property

CustomCollection would now become something like:

Option ExplicitPrivate m_coll As CollectionPrivate Sub Class_Initialize()    Set m_coll = New CollectionEnd SubPrivate Sub Class_Terminate()    Set m_coll = NothingEnd SubPublic Sub Add(v As Variant)    m_coll.Add vEnd SubPublic Function NewEnum() As EnumHelper    With New EnumHelper        Set .EnumVariant = m_coll.[_NewEnum]        Set NewEnum = .Self    End WithEnd Function

You would just need to call with For Each v in c.NewEnum

Although, the EnumHelper class would be an extra class needed in any project implementing a custom collection class, there are a couple of advantages as well:

1. You would never need to add the Attribute [MethodName].VB_UserMemId = -4 to any other custom collection class. This is even more useful for users that do not have RubberDuck installed ('@Enumerator annotation), as they would need to export, edit the .cls text file and import back for each custom collection class
2. You could expose multiple EnumHelpers for the same class. Consider a custom dictionary class. You could have an ItemsEnum and a KeysEnum at the same time. Both For Each v in c.ItemsEnum and For Each v in c.KeysEnum would work
3. You would never forget to use one of the workarounds presented above as the method exposing the EnumHelper class would be called before Invoke is calling member ID -4
4. You would not get crashes anymore. If you forget to call with For Each v in c.NewEnum and instead use For Each v in c you would just get a runtime error which would be picked up in testing anyway. Of course you could still force a crash by passing the result of c.NewEnum to another method ByRef which would then need to execute a For Each before any other method call or Set statement. Highly unlikely you would ever do that
5. Obvious but worth mentioning, you would use the same EnumHelper class for all the custom collection classes you might have in a project

I can't add a comment due to not having enough rep, nor can I use the chat section as that is frozen, but I wanted to add that I have come up against something that sounds eerily similar, and though I have yet to test any of the solutions presented here, it does seem that it is the same bug.

I've tried to describe it here:

https://docs.microsoft.com/en-us/answers/questions/464383/is-the-vba-64-bit-compiler-broken.html?childToView=545565#answer-545565

I'm hoping that testing will solve the issue for me as well, and if so you have my heartfelt thanks for investigating the issue and providing workarounds for what otherwise was meaning the code could not be ported to 64 bit VBA.