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:

• 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

---

CategoryVbClassic