1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
# -*- tcl -*-
# -------------------------------------------------------------------------
# critcl_callback.test
# -------------------------------------------------------------------------
source [file join [file dirname [info script]] support testutilities.tcl]
testsNeedTcl 8.6 9
testsNeedTcltest 2
support {
useLocal lib/stubs_container/container.tcl stubs::container
useLocal lib/stubs_reader/reader.tcl stubs::reader
useLocal lib/stubs_genframe/genframe.tcl stubs::gen
useLocal lib/critcl/critcl.tcl critcl
}
# -------------------------------------------------------------------------
## The critcl::callback package provides only stubs.
## To test this we create some basic commands linking the functions
## into the Tcl level.
testing {
# Must be installed
package require critcl::callback
puts *\t[join [info loaded] \n*\t]
puts -\t[critcl::This]
puts -\t[file dirname [file dirname [info library]]]/include/*
puts -\t[file dirname [file dirname [info nameofexecutable]]]/include/*
# Access to the stubs include files
critcl::cheaders [file dirname [file dirname [info library]]]/include/*
critcl::cheaders [file dirname [file dirname [info nameofexecutable]]]/include/*
critcl::api import critcl::callback 1
critcl::ccode {
static critcl_callback_p cb = 0;
}
critcl::cproc cb-make {Tcl_Interp* interp Tcl_Obj* args} void {
cb = critcl_callback_new (interp, args.c, args.v, 2);
critcl_callback_extend (cb, Tcl_NewStringObj("xyz", -1));
}
critcl::cproc cb-call {Tcl_Obj* value} void {
critcl_callback_invoke (cb, 1, &value);
}
critcl::cproc cb-done {} void {
critcl_callback_destroy (cb);
}
puts -\tLoaded=[critcl::load]
puts *\t[join [info loaded] \n*\t]
}
# -------------------------------------------------------------------------
##
test critcl-callback-1.0.0 {callback} -setup {
proc ::record {args} { lappend ::trace $args }
cb-make record
} -cleanup {
cb-done
unset ::trace
} -body {
cb-call 1
cb-call a
cb-call 22
cb-call bbb
set ::trace
} -result {{xyz 1} {xyz a} {xyz 22} {xyz bbb}}
# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
testsuiteCleanup
# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End:
|
