Stack Module In Vb Classic

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: 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

CategoryVbClassic

EditText of this page (last edited February 6, 2009) or FindPage with title or text search