From 6245ef410358f332330195f9f2bfa458cfb6a2b8 Mon Sep 17 00:00:00 2001 From: wtschueller Date: Tue, 10 Jun 2014 21:41:33 +0200 Subject: Tcl: collect XRefs also if INLINE_SOURCES = no --- src/tclscanner.l | 36 +++++++ testing/057/057__caller__graphs_8tcl.xml | 64 ++++++++++++ testing/057/namespace1.xml | 113 ++++++++++++++++++++ testing/057/namespace1_1_11.xml | 28 +++++ testing/057/namespace1_1_11_1_11.xml | 26 +++++ testing/057/namespace2.xml | 30 ++++++ testing/057/namespace2_1_12.xml | 29 ++++++ testing/057/namespace2_1_12_1_12.xml | 29 ++++++ testing/057/namespace2_1_12_1_12_1_12.xml | 29 ++++++ testing/057/namespace2_1_12_1_12_1_12_1_12.xml | 28 +++++ testing/057/namespacebar.xml | 57 ++++++++++ testing/057/namespacefoo.xml | 27 +++++ testing/057_caller_graphs.tcl | 138 +++++++++++++++++++++++++ 13 files changed, 634 insertions(+) create mode 100644 testing/057/057__caller__graphs_8tcl.xml create mode 100644 testing/057/namespace1.xml create mode 100644 testing/057/namespace1_1_11.xml create mode 100644 testing/057/namespace1_1_11_1_11.xml create mode 100644 testing/057/namespace2.xml create mode 100644 testing/057/namespace2_1_12.xml create mode 100644 testing/057/namespace2_1_12_1_12.xml create mode 100644 testing/057/namespace2_1_12_1_12_1_12.xml create mode 100644 testing/057/namespace2_1_12_1_12_1_12_1_12.xml create mode 100644 testing/057/namespacebar.xml create mode 100644 testing/057/namespacefoo.xml create mode 100644 testing/057_caller_graphs.tcl diff --git a/src/tclscanner.l b/src/tclscanner.l index 1fd20cd..7201088 100644 --- a/src/tclscanner.l +++ b/src/tclscanner.l @@ -451,6 +451,7 @@ static struct QList entry; // list of all created entries, will be deleted after codifying Protection protection; // current protections state MemberDef *memberdef; // contain current MemberDef when codifying + bool collectXRefs; } tcl; // scanner functions @@ -1652,6 +1653,40 @@ static void tcl_codify_link(QCString name) { myDef->addSourceReferencedBy(tcl.memberdef); tcl.memberdef->addSourceReferences(myDef); + } else { + Entry* callerEntry; + unsigned int i; + // walk the stack of scan contexts and find the enclosing method or proc + for (i=0;ientry_scan; + if (callerEntry->mtype==Method && !callerEntry->name.isEmpty()) + { + break; + } + } + if (iname; + if (callerName.mid(0,2)=="::") // fully qualified global command + { + callerName = callerName.mid(2); + } + else + { + if (!(tcl.scan.at(0)->ns.stripWhiteSpace().isEmpty())) + { + callerName = tcl.scan.at(0)->ns + "::" + callerEntry->name; + } + } + MemberDef *callerDef=NULL; + callerDef = fn.find(callerName); + if (callerDef!=NULL && myDef!= NULL && tcl.collectXRefs) + { + addDocCrossReference(callerDef,myDef); + } + } } } else if (tcl_keyword(myName)) // check keyword @@ -2634,6 +2669,7 @@ tcl_inf("%s (%d,%d) %d %d\n",myStr.ascii(),startLine,endLine,isExampleBlock,inli return; } tcl_init(); + tcl.collectXRefs = collectXRefs; tcl.memberdef = memberDef; tcl.code = &codeOutIntf; if (startLine<0) diff --git a/testing/057/057__caller__graphs_8tcl.xml b/testing/057/057__caller__graphs_8tcl.xml new file mode 100644 index 0000000..d2e3d84 --- /dev/null +++ b/testing/057/057__caller__graphs_8tcl.xml @@ -0,0 +1,64 @@ + + + + 057_caller_graphs.tcl + bar + foo + 1::1::1 + 1 + 1::1 + 2::2::2::2::2 + 2 + 2::2 + 2::2::2 + 2::2::2::2 + + + + baz + args + baz + + + + + + + + + + + bar + args + bar + + + + + + + + 1::test3 + + + + next + args + next + + + + + + + + 2::next + + + + + + + + + diff --git a/testing/057/namespace1.xml b/testing/057/namespace1.xml new file mode 100644 index 0000000..e40300d --- /dev/null +++ b/testing/057/namespace1.xml @@ -0,0 +1,113 @@ + + + + 1 + 1::1 + + + + 1::baz + args + baz + + + + + + + + test1 + test5 + + + + 1::bar + args + bar + + + + + + + + test2 + + + + 1::test1 + args + test1 + + + + + + + + baz + + + + 1::test2 + args + test2 + + + + + + + + bar + + + + 1::test3 + args + test3 + + + + + + + + bar + + + + 1::test4 + args + test4 + + + + + + + + 1::1::bar + + + + 1::test5 + args + test5 + + + + + + + + baz + + + + + + + + + diff --git a/testing/057/namespace1_1_11.xml b/testing/057/namespace1_1_11.xml new file mode 100644 index 0000000..157ab5e --- /dev/null +++ b/testing/057/namespace1_1_11.xml @@ -0,0 +1,28 @@ + + + + 1::1 + 1::1::1 + + + + 1::1::bar + args + bar + + + + + + + + 1::test4 + + + + + + + + + diff --git a/testing/057/namespace1_1_11_1_11.xml b/testing/057/namespace1_1_11_1_11.xml new file mode 100644 index 0000000..2f5a685 --- /dev/null +++ b/testing/057/namespace1_1_11_1_11.xml @@ -0,0 +1,26 @@ + + + + 1::1::1 + + + + 1::1::1::bar + args + bar + + + + + + + + + + + + + + + + diff --git a/testing/057/namespace2.xml b/testing/057/namespace2.xml new file mode 100644 index 0000000..47a9fcf --- /dev/null +++ b/testing/057/namespace2.xml @@ -0,0 +1,30 @@ + + + + 2 + 2::2 + + + + 2::next + args + next + + + + + + + + 2::2::next + next + 2::2::2::2::2::next + + + + + + + + + diff --git a/testing/057/namespace2_1_12.xml b/testing/057/namespace2_1_12.xml new file mode 100644 index 0000000..3338473 --- /dev/null +++ b/testing/057/namespace2_1_12.xml @@ -0,0 +1,29 @@ + + + + 2::2 + 2::2::2 + + + + 2::2::next + args + next + + + + + + + + 2::2::2::next + 2::next + + + + + + + + + diff --git a/testing/057/namespace2_1_12_1_12.xml b/testing/057/namespace2_1_12_1_12.xml new file mode 100644 index 0000000..259ef25 --- /dev/null +++ b/testing/057/namespace2_1_12_1_12.xml @@ -0,0 +1,29 @@ + + + + 2::2::2 + 2::2::2::2 + + + + 2::2::2::next + args + next + + + + + + + + 2::2::2::2::next + 2::2::next + + + + + + + + + diff --git a/testing/057/namespace2_1_12_1_12_1_12.xml b/testing/057/namespace2_1_12_1_12_1_12.xml new file mode 100644 index 0000000..cea3062 --- /dev/null +++ b/testing/057/namespace2_1_12_1_12_1_12.xml @@ -0,0 +1,29 @@ + + + + 2::2::2::2 + 2::2::2::2::2 + + + + 2::2::2::2::next + args + next + + + + + + + + 2::2::2::2::2::next + 2::2::2::next + + + + + + + + + diff --git a/testing/057/namespace2_1_12_1_12_1_12_1_12.xml b/testing/057/namespace2_1_12_1_12_1_12_1_12.xml new file mode 100644 index 0000000..65bfa00 --- /dev/null +++ b/testing/057/namespace2_1_12_1_12_1_12_1_12.xml @@ -0,0 +1,28 @@ + + + + 2::2::2::2::2 + + + + 2::2::2::2::2::next + args + next + + + + + + + + 2::next + 2::2::2::2::next + + + + + + + + + diff --git a/testing/057/namespacebar.xml b/testing/057/namespacebar.xml new file mode 100644 index 0000000..642986b --- /dev/null +++ b/testing/057/namespacebar.xml @@ -0,0 +1,57 @@ + + + + bar + + + + bar::slave + + slave + + + + + + + + baz + foo::master + + + + bar::baz + + baz + + + + + + + + bazbaz + slave + + + + bar::bazbaz + + bazbaz + + + + + + + + baz + + + + + + + + + diff --git a/testing/057/namespacefoo.xml b/testing/057/namespacefoo.xml new file mode 100644 index 0000000..11f8053 --- /dev/null +++ b/testing/057/namespacefoo.xml @@ -0,0 +1,27 @@ + + + + foo + + + + foo::master + + master + + + + + + + + bar::slave + + + + + + + + + diff --git a/testing/057_caller_graphs.tcl b/testing/057_caller_graphs.tcl new file mode 100644 index 0000000..25bf1e7 --- /dev/null +++ b/testing/057_caller_graphs.tcl @@ -0,0 +1,138 @@ +#// objective: test for completeness and correctness of references/referencedby relations +#// 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: 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 +} +# now, check with tcl what is called +foo::master +puts "" +foreach proc [lsort [info procs ::1::test?]] { + $proc + puts "" +} +::next +exit + -- cgit v0.12