Tcl: support eval/catch commands

--HG--
extra : rebase_source : 5d7e3a2b3c549419c672cddd8d780542053d68bb

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;}

testing/059_command_catch.tcl

+#// 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 <afaupell@users.sourceforge.net>
+#
+# ...
+# 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
+