summaryrefslogtreecommitdiffstats
path: root/testing/057_caller_graphs.tcl
blob: f6e0e776b5727e03432aa0d9a3aa75222c992be3 (plain)
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
#// objective: test for completeness and correctness of references/referencedby relations 
#// check: 057__caller__graphs_8tcl.xml
#// check: __057__caller__graphs_8tcl.xml
#// check: namespacebar.xml
#// check: namespacefoo.xml
#// check: namespace1.xml
#// check: namespace1_1_11.xml
#// check: namespace1_1_11_1_11.xml
#// check: namespace2.xml
#// check: namespace2_1_12.xml
#// check: namespace2_1_12_1_12.xml
#// check: namespace2_1_12_1_12_1_12.xml
#// check: namespace2_1_12_1_12_1_12_1_12.xml
#// config: EXTRACT_ALL = yes
#// config: INLINE_SOURCES = no
#// config: REFERENCED_BY_RELATION = yes
#// config: REFERENCES_RELATION = yes
#// config: INPUT = 057_caller_graphs.tcl _057_caller_graphs.tcl
# config: HAVE_DOT = yes
# config: CALLER_GRAPH = yes
# config: CALL_GRAPH = yes
# config: GENERATE_HTML = yes

# This is a stripped down example from my code.
# Doxygen 1.8.7 generates the correct relations (xml)
# but caller graphs will be incomplete.
# It does not generate any relations at all if INLINE_SOURCES = no.
namespace eval bar {}
proc bar::slave { } {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
    if {1} then {
        bar::baz
    }
    return 
}
proc bar::baz {} {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
    bar::bazbaz
}
proc bar::bazbaz {} {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
namespace eval foo {}
proc foo::master {  } {
    array set info [info frame 0]; puts -nonewline $info(proc)
    bar::slave
    return
}
#
# now we check tcl's rules: from the help
# NAME RESOLUTION
#... Command names are also always resolved by looking in the current
#namespace first. If not found there, they are searched for in every namespace on
#the current namespace's command path (which is empty by default). If not found
#there, command names are looked up in the global namespace (or, failing that,
#are processed by the unknown command.) ...
#
namespace eval ::1::1::1 {}
proc ::baz args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::1::baz args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::bar args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::1::bar args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::1::1::bar args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::1::1::1::bar args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
}
proc ::1::test1 args {
    array set info [info frame 0]; puts -nonewline $info(proc)
    baz
}
proc ::1::test2 args {
    array set info [info frame 0]; puts -nonewline $info(proc)
    bar
}
proc ::1::test3 args {
    array set info [info frame 0]; puts -nonewline $info(proc)
    ::bar
}
proc ::1::test4 args {
    array set info [info frame 0]; puts -nonewline $info(proc)
    1::bar
}
proc ::1::test5 args {
    array set info [info frame 0]; puts -nonewline $info(proc)
    1::baz
}
#
# funny example, do you see the infinite loop?
# we stop before the interpreter crashes
set ::countdown 10
namespace eval ::2::2::2::2::2 {}
proc ::next args {
    array set info [info frame 0]; puts $info(proc)
    2::next
}
proc ::2::next args {
    array set info [info frame 0]; puts $info(proc)
    incr ::countdown -1
    if {$::countdown>0} then {
        2::next
    } else {
        puts "stop after 10 rounds."
    }
}
proc ::2::2::next args {
    array set info [info frame 0]; puts $info(proc)
    2::next
}
proc ::2::2::2::next args {
    array set info [info frame 0]; puts $info(proc)
    2::next
}
proc ::2::2::2::2::next args {
    array set info [info frame 0]; puts $info(proc)
    2::next
}
proc ::2::2::2::2::2::next args {
    array set info [info frame 0]; puts $info(proc)
    2::next
}
#
# cross check with two files
# If doxygen did not do two passes, then xrefs would depend on file order
# and would be incomplete.
source _057_caller_graphs.tcl
proc master args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
    inFileB
    return
}
proc inFileA args {
    array set info [info frame 0]; puts -nonewline ->$info(proc)
    return
}
# now, check with tcl what is called
foo::master
puts ""
foreach proc [lsort [info procs ::1::test?]] {
    $proc
    puts ""
}
::next
master
exit