From 9d24b488add8b4c7c689f58a095184a6ed85e9f1 Mon Sep 17 00:00:00 2001 From: wtschueller Date: Tue, 17 Jun 2014 21:50:40 +0200 Subject: [PATCH] Tcl: support eval/catch commands --HG-- extra : rebase_source : 5d7e3a2b3c549419c672cddd8d780542053d68bb --- src/tclscanner.l | 51 +++++- testing/059/059__command__catch_8tcl.xml | 191 +++++++++++++++++++++++ testing/059_command_catch.tcl | 87 +++++++++++ 3 files changed, 327 insertions(+), 2 deletions(-) create mode 100644 testing/059/059__command__catch_8tcl.xml create mode 100644 testing/059_command_catch.tcl diff --git a/src/tclscanner.l b/src/tclscanner.l index 48e8214aa8c..0f35122794f 100644 --- a/src/tclscanner.l +++ b/src/tclscanner.l @@ -1816,6 +1816,42 @@ static tcl_scan *tcl_command_ARG(tcl_scan *myScan, unsigned int i, bool ignoreOu return (myScan); } +//! Handle internal tcl commands. +// "eval arg ?arg ...?" +static void tcl_command_EVAL() +{ +D + tcl_codify_cmd("keyword", 0); + tcl_scan *myScan = tcl.scan.at(0); + QCString myString = ""; + // we simply rescan the line without the eval + // we include leading whitespace because tcl_scan_start will examine + // the first char. If it finds a bracket it will assume one expression in brackets. + // Example: eval [list set] [list NotInvoked] [Invoked NotInvoked] + for (unsigned int i = 1; i < tcl.list_commandwords.count(); i++) + { + myString += (*tcl.list_commandwords.at(i)).utf8(); + } + myScan = tcl_scan_start('?', myString, + myScan->ns, myScan->entry_cl, myScan->entry_fn); +} + +//! Handle internal tcl commands. +// "catch script ?resultVarName? ?optionsVarName?" +static void tcl_command_CATCH() +{ +D + tcl_codify_cmd("keyword", 0); + tcl_codify_cmd(NULL, 1); + tcl_scan *myScan = tcl.scan.at(0); + myScan = tcl_scan_start('?', *tcl.list_commandwords.at(2), + myScan->ns, myScan->entry_cl, myScan->entry_fn); + for (unsigned int i = 3; i < tcl.list_commandwords.count(); i++) + { + myScan = tcl_command_ARG(myScan, i, false); + } +} + //! Handle internal tcl commands. // "if expr1 ?then? body1 elseif expr2 ?then? body2 elseif ... ?else? ?bodyN?" static void tcl_command_IF(QStringList type) @@ -2458,9 +2494,20 @@ tcl_inf("->\n"); } /* * Start of internal tcl keywords - * Ready: if, for, foreach, while - * TODO: switch, eval, ? + * Ready: eval, catch, if, for, foreach, while */ + if (myStr=="eval") + { + if (tcl.list_commandwords.count() < 3) {myLine=__LINE__;goto command_warn;} + tcl_command_EVAL(); + goto command_end; + } + if (myStr=="catch") + { + if (tcl.list_commandwords.count() < 3) {myLine=__LINE__;goto command_warn;} + tcl_command_CATCH(); + goto command_end; + } if (myStr=="for") { if (tcl.list_commandwords.count() != 9) {myLine=__LINE__;goto command_warn;} diff --git a/testing/059/059__command__catch_8tcl.xml b/testing/059/059__command__catch_8tcl.xml new file mode 100644 index 00000000000..6604413cc94 --- /dev/null +++ b/testing/059/059__command__catch_8tcl.xml @@ -0,0 +1,191 @@ + + + + 059_command_catch.tcl + + + + Invoked + args + Invoked + + should be reference by every proc below + + + + + + + a + b + c + d + e + f + g + h + i + j + + + + NotInvoked + args + NotInvoked + + must not be reference by every proc below + + + + + + + + + + a + args + a + + + + + + + + Invoked + + + + b + args + b + + + + + + + + Invoked + + + + c + args + c + + + + + + + + Invoked + + + + d + args + d + + + + + + + + Invoked + + + + e + args + e + + + + + + + + Invoked + + + + f + args + f + + + + + + + + Invoked + + + + g + args + g + + + + + + + + Invoked + + + + h + args + h + + + + + + + + Invoked + + + + i + args + i + + + + + + + + Invoked + + + + j + args + j + + + + + + + + Invoked + + + + + + + + + diff --git a/testing/059_command_catch.tcl b/testing/059_command_catch.tcl new file mode 100644 index 00000000000..4227da77dd9 --- /dev/null +++ b/testing/059_command_catch.tcl @@ -0,0 +1,87 @@ +#// objective: tests processing of catch/eval, only references/referencedby relations are relevant +#// check: 059__command__catch_8tcl.xml +#// config: REFERENCED_BY_RELATION = yes +#// config: REFERENCES_RELATION = yes +#// config: EXTRACT_ALL = yes +#// config: INLINE_SOURCES = no + +## +# \brief should be reference by every proc below +proc Invoked args { + puts "Procedure \"Invoked\" is invoked indeed. Ok." + return $args +} +## +# \brief must not be reference by every proc below +proc NotInvoked args { + puts "Procedure \"NotInvoked\" is invoked. Not Ok!" + return $args +} +# +# check if call references work at all +proc a args { + Invoked NotInvoked + return +} +# +# catch command +# Tcl8.5: catch script ?resultVarName? ?optionsVarName? +proc b args { + catch Invoked + return +} +proc c args { + catch Invoked NotInvoked + return +} +proc d args { + catch Invoked NotInvoked NotInvoked + return +} +proc e args { + set r [catch Invoked NotInvoked NotInvoked] + return +} +proc f args { + set r [catch {Invoked} NotInvoked NotInvoked] + return +} +proc g args { + set r [catch { + set x [Invoked] + } NotInvoked NotInvoked] + return +} +# eval arg ?arg ...? +proc h args { + eval Invoked NotInvoked + return +} +proc i args { + eval set NotInvoked [Invoked NotInvoked] + return +} +# This is a striped down example. Original: +# +# jpeg.tcl -- +# +# Querying and modifying JPEG image files. +# +# Copyright (c) 2004 Aaron Faupell +# +# ... +# eval [list addComment $file] [lreplace $com 0 0 $comment] +# ... +proc j args { + eval [list set] [list NotInvoked] [Invoked NotInvoked] + return +} +# +# call all single letter procs +# let tcl check what is called and what is not called +foreach p [info procs ?] { + puts "Check procedure \"$p\"" + $p +} +exit +