运行RDVBA测试多次后退出Excel出现高CPU占用卡死问题咨询

问题描述 #

包含3个VBA模块（2个类模块、1个标准模块）的工程，运行RubberDuck VBA测试后尝试关闭Excel时，会出现Excel卡死且持续占用CPU资源的问题。单次运行测试无法100%复现，运行至少2次测试后可稳定复现。

基础信息 #

• RDVBA版本：2.5.2.5871
• 操作系统：Microsoft 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

问题根因 #

1. 测试方法中的局部对象变量dbm未手动释放，RubberDuck测试运行时的上下文会临时持有VBA对象引用，导致测试执行完成后Class2、Class1的实例引用计数无法正常归零，出现引用泄漏。
2. 多次测试后泄漏的引用计数累积，Excel退出时释放COM对象的逻辑因引用计数异常进入死循环，最终表现为程序卡死、CPU占用居高不下。

解决方案 #

代码层面修复 #

1. 测试方法末尾手动释放局部对象，修改ztcCreate_VerifiesDefaultManager方法：

'@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
    ' 新增手动释放代码
    Set dbm = Nothing
End Sub

2. 为Class2添加显式释放方法，主动解除内部持有的Class1实例引用，避免交叉引用泄漏：
   首先在Class2中新增Dispose方法：

Friend Sub Dispose()
    Set this.DllMan = 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
    ' 先调用释放方法清理内部引用
    dbm.Dispose
    Set dbm = Nothing
End Sub

操作层面规避 #

RubberDuck 2.5.2正式版存在少量测试上下文对象泄漏的已知问题，升级到最新预览版可解决部分底层泄漏问题；每次运行测试后关闭Excel前，先在VBE编辑器点击「运行」-「重置」手动清空VBA运行时上下文，也可避免卡死问题。

内容的提问来源于stack exchange，提问作者PChemGuy