Excel hangs at exit after running RDVBA tests

Question

The following example contains three VBA modules: two classes and one regular. After I run RubberDuck VBA tests and then try to close Excel, Excel hangs while actively using the CPU. Running the tests once does not reproduce this issue every time, but when I do at least two runs, it seems that the issue is reproduced every time.

---

RDVBA Version 2.5.2.5871
OS: Microsoft Windows NT 6.2.9200.0, x64

Test environment 1:
Host Product: Microsoft Office XP x86
Host Version: 10.0.6501
Host Executable: EXCEL.EXE

Test environment 2:
Host Product: Microsoft Office 2016 x64
Host Version: 16.0.4266.1001
Host Executable: EXCEL.EXE

---

ModuleTests.bas

'@TestModule
Option Explicit
Option Private Module

Private Assert As Rubberduck.PermissiveAssertClass

#Const USE_ASSERT_OBJECT = True

'@ModuleInitialize
Private Sub ModuleInitialize()
    Set Assert = New Rubberduck.PermissiveAssertClass
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    Set Assert = Nothing
    Debug.Print CStr(Timer()) & ": Assert = Nothing"
End Sub

'@TestMethod("Factory")
Private Sub ztcCreate_VerifiesDefaultManager()
    Dim dbm As Class2
    Set dbm = Class2.Create(ThisWorkbook.Path)
    #If USE_ASSERT_OBJECT Then
        Assert.IsNotNothing dbm
    #Else
        Assert.IsTrue Not dbm Is Nothing
    #End If
End Sub

Class1.cls

'@PredeclaredId
Option Explicit

Public Function Create(Optional ByVal DefaultPath As String = vbNullString) As Class1
    Dim Instance As Class1
    Set Instance = New Class1
    Set Create = Instance
End Function

Private Sub Class_Terminate()
    Debug.Print CStr(Timer()) & ": Class1 Class_Terminate"
End Sub

Class2.cls

'@PredeclaredId
Option Explicit

Private Type TClass2
    DllMan As Class1
End Type
Private this As TClass2

'@DefaultMember
Public Function Create(ByVal DllPath As String) As Class2
    Dim Instance As Class2
    Set Instance = New Class2
    Instance.Init DllPath
    Set Create = Instance
End Function

Friend Sub Init(ByVal DllPath As String)
    Dim FileNames As Variant
    Set this.DllMan = Class1.Create(DllPath)
End Sub

Private Sub Class_Terminate()
    Debug.Print CStr(Timer()) & ": Class2 Class_Terminate"
End Sub

Answer 1

That flickering that you are seeing when Excel is hanging is basically Excel trying to clear an object from memory but failing. I know that for sure because the same thing happens if inside a userform there is a private custom class that doesn't get set to Nothing before the form unloads.

If you add this code to your Class2:

Friend Sub Clear()
    Set this.DllMan = Nothing
End Sub

and then update this:

Assert.IsNotNothing dbm

to this:

Assert.IsNotNothing dbm
dbm.Clear

inside the test method then the issue is gone.

Moreover, if I update the test method:

'@TestMethod("Factory")
Private Sub ztcCreate_VerifiesDefaultManager()
    Dim dbm As Class2
    Set dbm = Class2.Create(ThisWorkbook.Path)
    #If USE_ASSERT_OBJECT Then
        Assert.IsNotNothing dbm
        Debug.Print "Before Clear"
        dbm.Clear
        Debug.Print "After Clear"
    #Else
        Assert.IsTrue Not dbm Is Nothing
    #End If
    Debug.Print "After Test"
End Sub

then after I run the test I get this in the Immediate window:

and only after about 7 seconds I get the last line:

This suggests to me that the Assert.IsNotNothing holds on to the reference for longer than it should.

Edit #1

Removing the Clear method and changing the Terminate event for Class2 to this:

Private Sub Class_Terminate()
    Set this.DllMan = Nothing
    Debug.Print CStr(Timer()) & ": Class2 Class_Terminate"
End Sub

seems to also solve the issue. The only difference is that now both classes get delayed, as expected. So, the delay itself doesn't seem to be an issue.