How to test if two object variables reference the same object?

[joeu2004]

How can I test if two object variables reference the same object?

For example, suppose I construct a circular linked list of objects.
Then I want to walk the list until I get to the last object --
actually, until I wrap around to the first object again.

I might declare the following class module myTest1:

Private objInst As Long
Public nextObj As myTest1

Private Sub Class_Initialize()
objCnt = objCnt + 1
objInst = objCnt
End Sub

Property Get instNum() 'read-only
instNum = objInst
End Property

I would like to write the following in a standard module:

Public objcnt As Long

Private Sub testit()
Dim first As myTest1, last As myTest1
Dim i As Long, s As String, p As myTest1
'***** build circular linked list
Set first = New myTest1
Set last = first
Set first.nextObj = first
For i = 2 To 10
Set last.nextObj = New myTest1
Set last = last.nextObj
Set last.nextObj = first
Next
'***** walk circular list
s = first.instNum
Set p = first.nextObj
Do Until p = first '<--- does not work
s = s & Chr(10) & p.instNum
Set p = p.nextObj
Loop
MsgBox s
End Sub

Work-around: I must write `Do Until p.instNum = first.instNum`. I
would like to avoid this.

 

[joeu2004]

PS....

Do Until p = first        '<--- does not work

My intent is test if p and first reference the same object, not if the
content of the both objects are the same.

 

[Rick Rothstein]

Do Until p = first '<--- does not work

My intent is test if p and first reference the same
object, not if the content of the both objects are
the same.

Just a guess here, does using the "Is" operator do what you want...

Do Until p Is first

Rick Rothstein (MVP - Excel)

 

[Peter T]

Do Until p = first '<--- does not work

Do Until p.instNum = first.instNum

My intent is test if p and first reference the same object, not if the
content of the both objects are the same.

In that case more generally as Rick suggests
Do Until p Is first

Or you could also do
Do Until ObjPtr(p) = ObjPtr(first)

All three above will give same results in your test. And a very nasty little
test it is too, even if deliberately designed to leak memory

Regards,
Peter T

 

[joeu2004]

My intent is test if p and first reference the same
object, not if the content of the both objects are
the same.

[....]
Do Until p Is first

Thanks.

 

[joeu2004]

Peter and Rick (et al),

I would really appreciate your response to my other questions:

"Diff btwn Dim x and Private x in class module?"
http://groups.google.com/group/micr...ogramming/browse_frm/thread/ac893f9e4f0e8e40#

and

"What kernel function returns process stats"
http://groups.google.com/group/micr...ogramming/browse_frm/thread/94e23f46bdaa3865#

Thanks.

 

[Peter T]

Peter and Rick (et al),

I would really appreciate your response to my other questions:

"Diff btwn Dim x and Private x in class module?"
http://groups.google.com/group/micr...ogramming/browse_frm/thread/ac893f9e4f0e8e40#

That's n easy one, no difference. Dim/Private at module level in any type of
module are equivalent. As are Global/Public. But suggest use Private &
Public at module level for convention, even though the others are retained
for backwards compatibility.

"What kernel function returns process stats"
http://groups.google.com/group/micr...ogramming/browse_frm/thread/94e23f46bdaa3865#

Don't know, I've never looked into that

Regards,
Peter T

 

[joeu2004]

That's n easy one, no difference. Dim/Private at module
level in any type of module are equivalent. As are
Global/Public. But suggest use Private & Public at module
level for convention

That's what I determined empirically, too. And I agree with your
convention. It was just that Walkenbach used Dim in one (and only
one) example in the class module chapter; he used Private in the other
examples, but without comment about the difference. Since
Walkenbach's book are highly regarded by many (not I), I thought he
might have been trying to convey a subtle difference without
explanation :-(.

Good to hear that's not the case. And perhaps he fixed the Dim
declaration in later revisions of the book. Mine is for XL2003, 2nd
printing.

 

[Wouter HM]

Hi all,

If you would like it to be a two way linked list you can use:

For the classe:
-----
Option Explicit

Private objInst As Long
Public nextObj As myTest1
Public prevObj As myTest1

Private Sub Class_Initialize()
objcnt = objcnt + 1
objInst = objcnt
End Sub

Property Get instNum() 'read-only
instNum = objInst
End Property
-----

And for the module:
-----
Public objcnt As Long

Private Sub testit()
Dim first As myTest1, last As myTest1
Dim i As Long, s As String, p As myTest1
'***** build circular linked list
Set first = New myTest1
Set last = first
Set first.nextObj = first
Set last.prevObj = first
For i = 2 To 10
Set last.nextObj = New myTest1
Set last.nextObj.prevObj = last
Set last = last.nextObj
Set last.nextObj = first
Set first.prevObj = last
Next
'***** walk circular list
s = first.instNum
Set p = first.nextObj
Do Until p Is first '<--- does not work
s = s & Chr(10) & p.instNum
Set p = p.nextObj
Loop
MsgBox s
End Sub

 

[Wouter HM]

Hi,

I have inserted some code to show how to remove a instance from the
list:

Public objcnt As Long

Private Sub testit()
Dim first As myTest1, last As myTest1
Dim i As Long, s As String, p As myTest1
Dim r As Long, j As Long
'***** build circular linked list
Set first = New myTest1
Set last = first
Set first.nextObj = first
Set last.prevObj = first
For i = 2 To 10
Set last.nextObj = New myTest1
Set last.nextObj.prevObj = last
Set last = last.nextObj
Set last.nextObj = first
Set first.prevObj = last
Next
'***** walk circular list
s = first.instNum
Set p = first.nextObj
Do Until p Is first '<--- does not work
s = s & Chr(10) & p.instNum
Set p = p.nextObj
Loop
MsgBox s, vbOKOnly, "All"

For j = 1 To 5
' select a random number to
' remove a object from the list
Randomize (Timer)
Do
r = first.instNum + (Fix(Rnd() * _
first.prevObj.instNum - first.instNum))
Loop Until r >= first.instNum And _
r <= first.prevObj.instNum
Set p = first
Do Until p.instNum = r Or p Is last
Set p = p.nextObj
Loop

If p.instNum = r Then
' ajust next and prev
Set p.nextObj.prevObj = p.prevObj
Set p.prevObj.nextObj = p.nextObj
' remove selected
If first.instNum = p.instNum Then
Set first = first.nextObj
End If
If last.instNum = p.instNum Then
Set last = last.prevObj
End If

Set p = Nothing

'***** walk circular list
s = last.instNum
Set p = last.prevObj
Do Until p Is last
s = s & Chr(10) & p.instNum
Set p = p.prevObj
Loop
MsgBox s, vbOKOnly, "loop " & j & ", " & r & " removed"
Else
MsgBox r & " not found", vbOKOnly, "loop " & j
End If
Next

End Sub

 

[Peter T]

That's one way but to release all the objects you'd need to increase For j =
1 To 5
to a lot more. But even with that you'll end up with p.nextObj & p.prevObj
both referring to 'self', ie the same object as p, so finally need to do

Set p.nextObj = Nothing
Set p.prevObj = Nothing

then the object still assigned to p will self destruct as p falls out of
scope.

In real life of course never construct something like this!

Regards,
Peter T

 

[Wouter HM]

HI Peter,

I was only a way to remove an object and maintai the connection from
the previous en next.

I was not my intention to remove all.

Regards,

Wouter