Excel 在运行 RDVBA 测试后退出时挂起

Question

以下示例包含三个 VBA 模块：两个类和一个常规模块。在我运行 RubberDuck VBA 测试然后尝试关闭 Excel 之后，Excel 在主动使用 CPU 时挂起。运行测试一次并没有每次都重现这个问题，但是当我至少做了两次运行时，似乎每次都重现了这个问题。

RDVBA 版本 2.5.2.5871
OS：微软 Windows NT 6.2.9200.0，x64

测试环境1：
主机产品：Microsoft Office XP x86
主机版本：10.0.6501
主机可执行文件：EXCEL.EXE

测试环境2：
主机产品：Microsoft Office 2016 x64
主机版本：16.0.4266.1001
主机可执行文件：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

我修改了原始代码并运行进行了一些实验，暴露了一些奇怪的行为，如下图所示。虽然问题的性质仍不清楚并且似乎与 RDVBA 有关（我认为我现在有足够的证据来创建 RDVBA 问题），但我已经缩小了问题范围并找到了解决方法。

简而言之，我最初进行了此测试 Assert.IsNotNothing dbm，并且使用检测代码，我观察到奇怪的终止 timing/sequence。修改后的代码包括用于说明目的的条件编译结构。 When Assert.IsTrue Not dbm Is Nothing construct is selected instead, both symptoms and the issue are gone.

Answer 2

您在 Excel 挂起时看到的闪烁基本上是 Excel 试图从内存中清除对象但失败了。我肯定知道，因为如果在用户表单中有一个私人自定义 class 在表单卸载之前没有设置为 Nothing，也会发生同样的事情。

如果您将此代码添加到您的 Class2:

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

然后更新：

Assert.IsNotNothing dbm

对此：

Assert.IsNotNothing dbm
dbm.Clear

进入测试方法，问题就解决了。

此外，如果我更新测试方法：

'@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

然后在我运行测试后我立即得到这个 window:

大约 7 秒后我得到最后一行：

这向我表明 Assert.IsNotNothing 保留引用的时间超过了应有的时间。

编辑 #1

删除 Clear 方法并将 Class2 的终止事件更改为：

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

似乎也解决了这个问题。唯一的区别是现在两个 classes 都像预期的那样延迟了。所以，延迟本身似乎不是问题。

Excel 在运行 RDVBA 测试后退出时挂起

Excel hangs at exit after running RDVBA tests

excel

vba

rubberduck

Excel 在 运行 RDVBA 测试后退出时挂起

Excel hangs at exit after running RDVBA tests

excel

vba

rubberduck

Excel 在运行 RDVBA 测试后退出时挂起