excel - x64 カスタム クラスでの For Each 列挙のバグ

Question

数か月前に VBA のバグを発見しましたが、適切な回避策を見つけることができませんでした。このバグは、優れた言語機能を制限するようなものなので、本当に厄介です。

For Eachカスタム コレクション クラスを使用する場合、クラスをループで使用できるように列挙子が必要になることはよくあります。これは、次の行を追加することで実行できます。

Attribute [MethodName].VB_UserMemId = -4 'The reserved DISPID_NEWENUM

次のいずれかの方法で、関数/プロパティ シグネチャ行の直後に挿入します。

1. クラス モジュールをエクスポートし、テキスト エディタで内容を編集してからインポートし直す
2. 関数シグネチャの上にラバーダックアノテーションを使用してから同期する'@Enumerator

残念ながら、x64 では、上記の機能を使用すると、間違ったメモリが書き込まれ、場合によってはアプリケーションがクラッシュします (後述)。

バグの再現

CustomCollectionクラス：

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CustomCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_coll As Collection

Private Sub Class_Initialize()
    Set m_coll = New Collection
End Sub
Private Sub Class_Terminate()
    Set m_coll = Nothing
End Sub

Public Sub Add(v As Variant)
    m_coll.Add v
End Sub

Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = m_coll.[_NewEnum]
End Function

標準モジュールのコード:

Option Explicit

Sub 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 If
End Sub

Sub ShowBug(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.Assert ptr0 = 0
End Sub

メソッドを実行するMainと、コードはメソッドのAssert行で停止し、[ローカル]ウィンドウで、ローカル変数の値がどこからともなく変更されたShowBugことを確認できます。ここで、 ptr1 は に等しいです。メソッド内でより多くの変数が使用される(オプションのパラメーターを含む) ほど、値 (メモリ アドレス) が書き込まれるメソッド内のより多くの ptr が取得されます。

ObjPtr(c)NewEnumShowBug

言うまでもなく、メソッド内のローカルptr変数を削除するShowBugと、アプリケーションのクラッシュが確実に発生します。

コードを 1 行ずつステップ実行すると、このバグは発生しません。

---

バグの詳細

Collectionこのバグは、内に格納されている実際のものとは関係ありませんCustomCollection。NewEnum 関数が呼び出された直後にメモリが書き込まれます。したがって、基本的に次のいずれかを実行しても効果はありません (テスト済み):

1. Optionalパラメータの追加
2. 関数内からすべてのコードを削除します（これを示す以下のコードを参照）
3. IUnknownの代わりとして宣言するIEnumVariant
4. Functionとして宣言する代わりにProperty Get
5. メソッド シグネチャでFriendorのようなキーワードを使用するStatic
6. DISPID_NEWENUM をGetのLetまたはSetに対応するものに追加するか、前者を非表示にします (つまり、Let/Set をプライベートにします)。

上記のステップ 2 を試してみましょう。次の場合CustomCollection:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CustomCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
End Function

テストに使用されるコードは次のように変更されます。

Sub Main()
    #If Win64 Then
        Dim c As New CustomCollection
        ShowBug c
    #Else
        MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
    #End If
End Sub

Sub ShowBug(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
    '
    On Error Resume Next
    For Each v In c
    Next v
    On Error GoTo 0
    Debug.Assert ptr0 = 0
End Sub

実行Mainすると同じバグが発生します。

回避策

バグを回避するために私が見つけた信頼できる方法：

1. メソッドを呼び出して (基本的にはShowBugメソッドから離れて)、戻ってきます。これは、For Each行が実行される前に発生する必要があります (同じメソッド内のどこにでもある可能性があることを意味する前に、必ずしも正確な行の前にあるとは限りません)。

   Sin 0 'Or VBA.Int 1 - you get the idea
   For Each v In c
   Next v
   

   短所：忘れやすい

2. Setステートメントを行います。ループで使用されるバリアントにある可能性があります (他のオブジェクトが使用されていない場合)。上記のポイント 1 のように、これはFor Each行が実行される前に発生する必要があります。

   Set v = Nothing
   For Each v In c
   Next v
   

   Set c = c
   Or を使用してコレクションをそれ自体に設定し、 cパラメーターByValをShowBugメソッドに渡すことによっても (Set として、IUnknown::AddRef を呼び出します)
   短所: 忘れやすい

3. EnumHelper列挙に使用された唯一のクラスである別のクラスを使用します。

   VERSION 1.0 CLASS
   BEGIN
     MultiUse = -1  'True
   END
   Attribute VB_Name = "EnumHelper"
   Attribute VB_GlobalNameSpace = False
   Attribute VB_Creatable = False
   Attribute VB_PredeclaredId = False
   Attribute VB_Exposed = False
   Option Explicit
   
   Private m_enum As IEnumVARIANT
   
   Public Property Set EnumVariant(newEnum_ As IEnumVARIANT)
       Set m_enum = newEnum_
   End Property
   Public Property Get EnumVariant() As IEnumVARIANT
   Attribute EnumVariant.VB_UserMemId = -4
       Set EnumVariant = m_enum
   End Property
   

   CustomCollection次のようになります。

   VERSION 1.0 CLASS
   BEGIN
     MultiUse = -1  'True
   END
   Attribute VB_Name = "CustomCollection"
   Attribute VB_GlobalNameSpace = False
   Attribute VB_Creatable = False
   Attribute VB_PredeclaredId = False
   Attribute VB_Exposed = False
   Option Explicit
   
   Private m_coll As Collection
   
   Private Sub Class_Initialize()
       Set m_coll = New Collection
   End Sub
   Private Sub Class_Terminate()
       Set m_coll = Nothing
   End Sub
   
   Public Sub Add(v As Variant)
       m_coll.Add v
   End Sub
   
   Public Function NewEnum() As EnumHelper
       Dim eHelper As New EnumHelper
       '
       Set eHelper.EnumVariant = m_coll.[_NewEnum]
       Set NewEnum = eHelper
   End Function
   

   および呼び出しコード:

   Option Explicit
   
   Sub 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 If
   End Sub
   
   Sub ShowBug(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.NewEnum
           Debug.Print v
       Next v
       Debug.Assert ptr0 = 0
   End Sub
   

   明らかに、予約済みの DISPID はCustomCollectionクラスから削除されました。

   長所：カスタムコレクションを直接ではなくFor Each、関数に強制します。.NewEnumこれにより、バグによるクラッシュが回避されます。

   短所：常に余分なEnumHelperクラスが必要です。.NewEnum行に を追加するのを忘れがちFor Eachです (実行時エラーが発生するだけです)。

最後のアプローチ (3) が機能するのは、c.NewEnumが実行されるとメソッドが終了し、クラス内のShowBug呼び出しの前に返されるためです。基本的には(1)がバグを回避する方法です。Property Get EnumVariantEnumHelper

---

この動作の説明は何ですか? このバグをよりエレガントな方法で回避できますか?

編集

ByVal を渡すことCustomCollectionは常にオプションではありません。を検討してくださいClass1：

Option Explicit

Private m_collection As CustomCollection

Private Sub Class_Initialize()
    Set m_collection = New CustomCollection
End Sub
Private Sub Class_Terminate()
    Set m_collection = Nothing
End Sub

Public Sub AddElem(d As Double)
    m_collection.Add d
End Sub

Public Function SumElements() As Double
    Dim v As Variant
    Dim s As Double
    
    For Each v In m_collection
        s = s + v
    Next v
    SumElements = s
End Function

そして今、呼び出しルーチン:

Sub ForceBug()
    Dim c As Class1
    Set c = New Class1
    c.AddElem 2
    c.AddElem 5
    c.AddElem 7
    
    Debug.Print c.SumElements 'BOOM - Application crashes
End Sub

明らかに、この例は少し強引ですが、「子」オブジェクトのカスタム コレクションを含む「親」オブジェクトを持ち、「親」が「子」の一部またはすべてを含む何らかの操作を実行することは非常に一般的です。

この場合、行Setの前にステートメントまたはメソッド呼び出しを行うことを忘れがちです。For Each