/trunk/Examples/test-suite/tcl/member_pointer_runme.tcl

 1# Example using pointers to member functions
 2
 3if [ catch { load ./member_pointer[info sharedlibextension] member_pointer} err_msg ] {
 4	puts stderr "Could not load shared object:\n$err_msg"
 5}
 6
 7proc check {what expected actual} {
 8  if {$expected != $actual } {
 9    error "Failed: $what , Expected: $expected , Actual: $actual"
10  }
11}
12# Get the pointers
13
14set area_pt [ areapt ]
15set perim_pt [ perimeterpt ]
16
17# Create some objects
18
19set s [Square -args 10]
20
21# Do some calculations
22
23check "Square area " 100.0 [do_op $s $area_pt]
24check "Square perim" 40.0 [do_op $s $perim_pt]
25
26set memberPtr $areavar
27set memberPtr $perimetervar
28
29# Try the variables
30check "Square area " 100.0 [do_op $s $areavar]
31check "Square perim" 40.0 [do_op $s $perimetervar]
32
33# Modify one of the variables
34set areavar $perim_pt
35
36check "Square perimeter" 40.0 [do_op $s $areavar]
37
38# Try the constants
39
40set memberPtr $AREAPT
41set memberPtr $PERIMPT
42set memberPtr $NULLPT
43
44check "Square area " 100.0 [do_op $s $AREAPT]
45check "Square perim" 40.0 [do_op $s $PERIMPT]
46