gdb/testsuite/lib/data-structures.exp

   1 # Copyright 2017-2023 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # This file implements some simple data structures in Tcl.
  17
  18 # A namespace/commands to support a stack.
  19 #
  20 # To create a stack, call ::Stack::new, recording the returned object ID
  21 # for future calls to manipulate the stack object.
  22 #
  23 # Example:
  24 #
  25 # set sid [::Stack::new]
  26 # stack push $sid a
  27 # stack push $sid b
  28 # stack empty $sid;  # returns false
  29 # stack pop $sid;    # returns "b"
  30 # stack pop $sid;    # returns "a"
  31 # stack pop $sid;    # errors with "stack is empty"
  32 # stack delete $sid1
  33
  34 namespace eval ::Stack {
  35     # A counter used to create object IDs
  36     variable num_ 0
  37
  38     # An array holding all object lists, indexed by object ID.
  39     variable data_
  40
  41     # Create a new stack object, returning its object ID.
  42     proc new {} {
  43         variable num_
  44         variable data_
  45
  46         set oid [incr num_]
  47         set data_($oid) [list]
  48         return $oid
  49     }
  50
  51     # Delete the given stack ID.
  52     proc delete {oid} {
  53         variable data_
  54
  55         error_if $oid
  56         unset data_($oid)
  57     }
  58
  59     # Returns whether the given stack is empty.
  60     proc empty {oid} {
  61         variable data_
  62
  63         error_if $oid
  64         return [expr {[llength $data_($oid)] == 0}]
  65     }
  66
  67     # Push ELEM onto the stack given by OID.
  68     proc push {oid elem} {
  69         variable data_
  70
  71         error_if $oid
  72         lappend data_($oid) $elem
  73     }
  74
  75     # Return and pop the top element on OID.  It is an error to pop
  76     # an empty stack.
  77     proc pop {oid} {
  78         variable data_
  79
  80         error_if $oid
  81         if {[llength $data_($oid)] == 0} {
  82             ::error "stack is empty"
  83         }
  84         set elem [lindex $data_($oid) end]
  85         set data_($oid) [lreplace $data_($oid) end end]
  86         return $elem
  87     }
  88
  89     # Returns the depth of a given ID.
  90     proc length {oid} {
  91         variable data_
  92
  93         error_if $oid
  94         return [llength $data_($oid)]
  95     }
  96
  97     # Error handler for invalid object IDs.
  98     proc error_if {oid} {
  99         variable data_
 100
 101         if {![info exists data_($oid)]} {
 102             ::error "object ID $oid does not exist"
 103         }
 104     }
 105
 106     # Export procs to be used.
 107     namespace export empty push pop new delete length error_if
 108
 109     # Create an ensemble command to use instead of requiring users
 110     # to type namespace proc names.
 111     namespace ensemble create -command ::stack
 112 }
 113
 114 # A namespace/commands to support a queue.
 115 #
 116 # To create a queue, call ::Queue::new, recording the returned queue ID
 117 # for future calls to manipulate the queue object.
 118 #
 119 # Example:
 120 #
 121 # set qid [::Queue::new]
 122 # queue push $qid a
 123 # queue push $qid b
 124 # queue empty $qid;  # returns false
 125 # queue pop $qid;    # returns "a"
 126 # queue pop $qid;    # returns "b"
 127 # queue pop $qid;    # errors with "queue is empty"
 128 # queue delete $qid
 129
 130 namespace eval ::Queue {
 131
 132     # Remove and return the oldest element in the queue given by OID.
 133     # It is an error to pop an empty queue.
 134     proc pop {oid} {
 135         variable ::Stack::data_
 136
 137         error_if $oid
 138         if {[llength $data_($oid)] == 0} {
 139             error "queue is empty"
 140         }
 141         set elem [lindex $data_($oid) 0]
 142         set data_($oid) [lreplace $data_($oid) 0 0]
 143         return $elem
 144     }
 145
 146     # "Unpush" ELEM back to the head of the queue given by QID.
 147     proc unpush {oid elem} {
 148         variable ::Stack::data_
 149
 150         error_if $oid
 151         set data_($oid) [linsert $data_($oid) 0 $elem]
 152     }
 153
 154     # Re-use some common routines from the Stack implementation.
 155     namespace import ::Stack::create ::Stack::new ::Stack::empty \
 156         ::Stack::delete ::Stack::push ::Stack::length ::Stack::error_if
 157
 158     # Export procs to be used.
 159     namespace export new empty push pop new delete length error_if unpush
 160
 161     # Create an ensemble command to use instead of requiring users
 162     # to type namespace proc names.
 163     namespace ensemble create -command ::queue
 164 }