← Back to branch summary

~ubuntu-branches/ubuntu/trusty/dejagnu/trusty-proposed

« back to all changes in this revision

Viewing changes to lib/debugger.exp

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Jacobowitz
  • Date: 2006-12-11 09:06:59 UTC
  • mfrom: (2.1.6 edgy)
  • Revision ID: james.westby@ubuntu.com-20061211090659-w586kgi3giz84053
Tags: 1.4.4.cvs20060709-3
* Acknowledge previous NMUs.
* Fix permissions on /usr/share/dejagnu when building without fakeroot
  (Closes: #392589, #379809).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/debugger.exp
15
15
#
16
16
# You should have received a copy of the GNU General Public License
17
17
# along with DejaGnu; if not, write to the Free Software Foundation,
18
 
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19
 
 
20
 
# This file was written by Rob Savoye. (rob@welcomehome.org)
21
 
 
 
18
# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
 
19
 
 
20
# This file was written by Rob Savoye <rob@welcomehome.org>.
 
21
 
 
22
# Dump the values of a shell expression representing variable names.
22
23
#
23
 
# Dump the values of a shell expression representing variable
24
 
# names.
25
24
proc dumpvars { args } {
26
25
    uplevel 1 [list foreach i [uplevel 1 "info vars $args"] {
27
26
        if { [catch "array names $i" names ] } {
35
34
              ]
36
35
}
37
36
 
 
37
# Dump the values of a shell expression representing variable names.
38
38
#
39
 
# dump the values of a shell expression representing variable
40
 
# names.
41
39
proc dumplocals { args } {
42
40
    uplevel 1 [list foreach i [uplevel 1 "info locals $args"] {
43
41
        if { [catch "array names $i" names ] } {
50
48
    }
51
49
              ]
52
50
}
53
 
#
 
51
 
54
52
# Dump the body of procedures specified by a regexp.
55
53
#
56
54
proc dumprocs { args } {
59
57
    }
60
58
}
61
59
 
62
 
#
63
 
# Dump all the current watchpoints
 
60
# Dump all the current watchpoints.
64
61
#
65
62
proc dumpwatch { args } {
66
63
    foreach i [uplevel 1 "info vars $args"] {
67
64
        set tmp ""
68
65
        if { [catch "uplevel 1 array name $i" names] } {
69
66
            set tmp [uplevel 1 trace vinfo $i]
70
 
            if ![string match "" $tmp] {
 
67
            if {![string match "" $tmp]} {
71
68
                puts "$i $tmp"
72
69
            }
73
70
        } else {
74
71
            foreach k $names {
75
72
                set tmp [uplevel 1 trace vinfo [set i]($k)]
76
 
                if ![string match "" $tmp] {
 
73
                if {![string match "" $tmp]} {
77
74
                    puts "[set i]($k) = $tmp"
78
75
                }
79
76
            }
81
78
    }
82
79
}
83
80
 
84
 
#
85
 
# Trap a watchpoint for an array
86
 
#
87
 
proc watcharray { element type} {
 
81
# Trap a watchpoint for an array.
 
82
#
 
83
proc watcharray { array element op } {
88
84
    upvar [set array]($element) avar
89
 
    case $type {
 
85
    switch $op {
90
86
        "w" { puts "New value of [set array]($element) is $avar" }
91
87
        "r" { puts "[set array]($element) (= $avar) was just read" }
92
88
        "u" { puts "[set array]($element) (= $avar) was just unset" }
93
89
    }
94
90
}
95
91
 
96
 
proc watchvar { v type } {
 
92
proc watchvar { v ignored op } {
97
93
    upvar $v var
98
 
    case $type {
 
94
    switch $op {
99
95
        "w" { puts "New value of $v is $var" }
100
96
        "r" { puts "$v (=$var) was just read" }
101
97
        "u" { puts "$v (=$var) was just unset" }
102
98
    }
103
99
}
104
100
 
105
 
#
106
 
# Watch when a variable is written
 
101
# Watch when a variable is written.
107
102
#
108
103
proc watchunset { arg } {
109
104
    if { [catch "uplevel 1 array name $arg" names ] } {
110
 
        if ![uplevel 1 info exists $arg] {
 
105
        if {![uplevel 1 info exists $arg]} {
111
106
            puts stderr "$arg does not exist"
112
107
            return
113
108
        }
114
109
        uplevel 1 trace variable $arg u watchvar
115
110
    } else {
116
111
        foreach k $names {
117
 
            if ![uplevel 1 info exists $arg] {
 
112
            if {![uplevel 1 info exists $arg]} {
118
113
                puts stderr "$arg does not exist"
119
114
                return
120
115
            }
123
118
    }
124
119
}
125
120
 
126
 
#
127
 
# Watch when a variable is written
 
121
# Watch when a variable is written.
128
122
#
129
123
proc watchwrite { arg } {
130
124
    if { [catch "uplevel 1 array name $arg" names ] } {
131
 
        if ![uplevel 1 info exists $arg] {
 
125
        if {![uplevel 1 info exists $arg]} {
132
126
            puts stderr "$arg does not exist"
133
127
            return
134
128
        }
135
129
        uplevel 1 trace variable $arg w watchvar
136
130
    } else {
137
131
        foreach k $names {
138
 
            if ![uplevel 1 info exists $arg] {
 
132
            if {![uplevel 1 info exists $arg]} {
139
133
                puts stderr "$arg does not exist"
140
134
                return
141
135
            }
144
138
    }
145
139
}
146
140
 
147
 
#
148
 
# Watch when a variable is read
 
141
# Watch when a variable is read.
149
142
#
150
143
proc watchread { arg } {
151
144
    if { [catch "uplevel 1 array name $arg" names ] } {
152
 
        if ![uplevel 1 info exists $arg] {
 
145
        if {![uplevel 1 info exists $arg]} {
153
146
            puts stderr "$arg does not exist"
154
147
            return
155
148
        }
156
149
        uplevel 1 trace variable $arg r watchvar
157
150
    } else {
158
151
        foreach k $names {
159
 
            if ![uplevel 1 info exists $arg] {
 
152
            if {![uplevel 1 info exists $arg]} {
160
153
                puts stderr "$arg does not exist"
161
154
                return
162
155
            }
165
158
    }
166
159
}
167
160
 
168
 
#
169
 
# Delete a watch point
 
161
# Delete a watchpoint.
170
162
#
171
163
proc watchdel { args } {
172
164
    foreach i [uplevel 1 "info vars $args"] {
185
177
    }
186
178
}
187
179
 
188
 
#
189
180
# This file creates GDB style commands for the Tcl debugger
190
181
#
191
182
proc print { var } {
197
188
}
198
189
 
199
190
proc bt { } {
 
191
    # The w command is provided by the Tcl debugger.
200
192
    puts "[w]"
201
193
}
202
194
 
203
 
#
204
 
# create some stub procedures since we can't alias the command names
 
195
# Create some stub procedures since we can't alias the command names.
205
196
#
206
197
proc dp { args } {
207
198
    uplevel 1 dumprocs $args