Here is a stack written as a VbClassic Module. How could it be better? Feel free to reuse as you see fit.
I find using a collection would be a simpler thing that could possibly work. Here are some tests and code for a generic and string stack -- ThomasEyde:
Jun 15, 2002: I have removed duplication in CStack and changed naming conventions to a (hopefully) more Wiki friendly style. The tests are unchanged. Thanks for noticing. -- Thomas Eyde
Easter, 2007: I don't know why I bother to do this when ClassicVb is dead and all that, but I have my pride in published code. I have honed my skills over the years and I felt like refactor this code to reflect my current understanding:
- One test pr concept
- Microsoftish naming conventions
- One responsibility pr class and member
- Place responsibilites where they belong
The tests still do the same thing after the face-lift:
'
' Module: AllTests
'
Option Explicit
Public Sub Run()
StackTests.Run
StringStackTests.Run
End Sub
'
' Module: StackTests
'
Option Explicit
Public Sub Run()
NewStackIsEmpty
PopEmptyStackReturnsEmpty
PeekEmptyStackReturnsEmpty
StackIsNotEmptyAfterPush
PeekPushedItem
PeekDoesntChangeStack
PopPushedItem
PopRemovesItemFromStack
PushNumberToStack
PushMixedTypesToStack
End Sub
Private Sub NewStackIsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.IsEmpty
End Sub
Private Sub PopEmptyStackReturnsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.Pop = Empty
End Sub
Private Sub PeekEmptyStackReturnsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.Peek = Empty
End Sub
Private Sub StackIsNotEmptyAfterPush()
Dim aStack As New CStack
aStack.Push 1
Debug.Assert Not aStack.IsEmpty
End Sub
Private Sub PeekPushedItem()
Dim aStack As New CStack
aStack.Push 1
Debug.Assert aStack.Peek = 1
End Sub
Private Sub PeekDoesntChangeStack()
Dim aStack As New CStack
aStack.Push 1
aStack.Peek
Debug.Assert Not aStack.IsEmpty
End Sub
Private Sub PopPushedItem()
Dim aStack As New CStack
aStack.Push 1
Debug.Assert aStack.Pop = 1
End Sub
Private Sub PopRemovesItemFromStack()
Dim aStack As New CStack
aStack.Push 1
aStack.Pop
Debug.Assert aStack.IsEmpty
End Sub
Private Sub PushNumberToStack()
Dim aStack As New CStack
aStack.Push 1
Debug.Assert aStack.Peek = 1
Debug.Assert aStack.Pop = 1
End Sub
Private Sub PushMixedTypesToStack()
Dim aStack As New CStack
aStack.Push "one"
aStack.Push 2
aStack.Push New Collection
Debug.Assert TypeOf aStack.Peek Is Collection
Debug.Assert TypeOf aStack.Pop Is Collection
Debug.Assert aStack.Peek = 2
Debug.Assert aStack.Pop = 2
Debug.Assert aStack.Peek = "one"
Debug.Assert aStack.Pop = "one"
End Sub
'
' Module: StringStackTests
'
Option Explicit
Public Sub Run()
NewStackIsEmpty
PopEmptyStackReturnsEmpty
PeekEmptyStackReturnsEmpty
StackIsNotEmptyAfterPush
PushStringsToStack
End Sub
Private Sub NewStackIsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.IsEmpty
End Sub
Private Sub PopEmptyStackReturnsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.Pop = ""
End Sub
Private Sub PeekEmptyStackReturnsEmpty()
Dim aStack As New CStack
Debug.Assert aStack.Peek = ""
End Sub
Private Sub StackIsNotEmptyAfterPush()
Dim aStack As New CStack
aStack.Push "one"
Debug.Assert Not aStack.IsEmpty
End Sub
Private Sub PushStringsToStack()
Dim aStack As New CStringStack
aStack.Push "one"
aStack.Push 2
Debug.Assert aStack.Peek = "2"
Debug.Assert aStack.Pop = "2"
Debug.Assert aStack.Peek = "one"
Debug.Assert aStack.Pop = "one"
End Sub
The stack got some minor changes:
'
' Class: CStack
'
Option Explicit
Private underlyingList As New Collection
Public Sub Push(ByVal newValue As Variant)
underlyingList.Add newValue
End Sub
Public Function Pop() As Variant
If Not IsEmpty Then
AssignNextValueTo Pop
RemoveNext
End If
End Function
Public Function Peek() As Variant
If Not IsEmpty Then
AssignNextValueTo Peek
End If
End Function
Public Function IsEmpty() As Boolean
IsEmpty = (NextIndex = 0)
End Function
Private Sub RemoveNext()
If Not IsEmpty Then
underlyingList.Remove NextIndex
End If
End Sub
Private Sub AssignNextValueTo(ByRef aValue As Variant)
If IsObject(underlyingList(NextIndex)) Then
Set aValue = underlyingList(NextIndex)
Else
aValue = underlyingList(NextIndex)
End If
End Sub
Private Property Get NextIndex() As Long
NextIndex = underlyingList.Count
End Property
The string stack suffered only a few renames:
'
' Class: CStringStack
'
Option Explicit
Private underlyingStack As New CStack
Public Sub Push(ByVal aValue As String)
underlyingStack.Push aValue
End Sub
Public Function Pop() As String
Pop = underlyingStack.Pop
End Function
Public Function Peek() As String
Peek = underlyingStack.Peek
End Function
Public Function IsEmpty() As Boolean
IsEmpty = underlyingStack.IsEmpty
End Function
I havent touched anything VB in years but surely this can be done better, from a reuse point of view? Does VB support the idea of an interface? (so you can have different classes which implement the stack protocol, and use them interchangably) Or genericity, so you can have a stack which only accepts a particular type?
Actually, yes VB does support the idea of an interface (see VisualBasicInterfaceInheritance). However, when I wrote this, I was practicing doing the least thing that could possible work. [DoTheSimplestThingThatCouldPossiblyWork] I will keep in mind that this should be an interface setup if I ever get around to building this as a COM object.
Initial tests indicated that it works perfectly as an Access 97 Class Module, FYI
Maybee try to get rid of some of the repetition of MyList(MyList.Count), also Pop contains code that is in peek, it could call peek and then remove the last item in the collection. MyList.Count could maybe be a private property call StackTop or maybe not. But hell it works, its got tests and anyone with half a brain can understand it. You are in the top ten percentile of VB developers for usefullness.
Thank you for the kind words. It's been a while since I last read this page. I actually forgot I put some code here, but the fact that I can still read it is promising. Now that I read it, I agree: MyList.Count is repetitious. -- ThomasEyde
On the "Err.Raise" statements, it's good form to do
Err.Raise vbObjectError + <app_number>, ...
where "<app_number>" is some application-defined error number. [VbErrRaise]
'this stack doesn't really deal with objects so well.
'it is just fine with non object varients of all types
'to make it an object stack should be easy though.
Option Explicit
'local variable(s) to hold property value(s)
Private iCount As Integer 'local copy
Private aryStack() As Variant
Public Property Get Count() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Count
Count = iCount
End Property
Public Sub Push(ByVal vrtItem As Variant)
If UBound(aryStack) = iCount Then Resize
iCount = iCount + 1
aryStack(iCount) = vrtItem
End Sub
Public Function Pop() As Variant
Dim ret As Integer
If iCount = 0 Then
Err.Raise 5111, "Stack.Pop", "Programmer attempted to pop empty stack."
Exit Function
End If
ret = iCount
iCount = iCount - 1
Pop = aryStack(ret)
End Function
Public Function Peek() As Variant
Dim ret As Integer
If iCount = 0 Then
Err.Raise 5111, "Stack.Pop", "Programmer attempted to pop empty stack."
Exit Function
End If
ret = iCount
Peek = aryStack(ret)
End Function
Private Sub Resize()
Dim temp As Integer
temp = UBound(aryStack) * 2
ReDim Preserve aryStack(1 To temp) As Variant
End Sub
Private Sub Class_Initialize()
iCount = 0
ReDim Preserve aryStack(1 To 10) As Variant
End Sub