[scope] command + tests

3 files changed, 105 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index 6d042bb..1e21475 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-03-26 15:12  antirez
+
+	* ChangeLog, Makefile, jim-sdl.c, jim.c: some GFX primitive to SDL
+	  extension. Minor changes to jim.c
+
 2005-03-25 10:34  antirez
 
 	* ChangeLog, bench.tcl, jim.c: SetReturnCodeFromAny() modified to
diff --git a/jim.c b/jim.c
index 3211c15..4ea60f3 100644
--- a/jim.c
+++ b/jim.c
@@ -2,7 +2,7 @@
  * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
  * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
  *
- * $Id: jim.c,v 1.130 2005/03/26 14:12:32 antirez Exp $
+ * $Id: jim.c,v 1.131 2005/03/28 16:57:36 antirez Exp $
  *
  * Licensed under the Apache License, Version 2.0 (the "License");
  * you may not use this file except in compliance with the License.
@@ -10753,7 +10753,46 @@ static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
     return JIM_OK;
 }
 
-/* [lrange] */
+/* [scope] */
+static int Jim_ScopeCoreCommand(Jim_Interp *interp, int argc,
+        Jim_Obj *const *argv)
+{
+    Jim_Obj **savedVect, *resultObjPtr, *varNameObjPtr;
+    int len, i, retCode;
+
+    if (argc != 3) {
+        Jim_WrongNumArgs(interp, 1, argv, "varList body");
+        return JIM_ERR;
+    }
+    /* Save the value of every var in varList into the 'savedVect' vector. */
+    Jim_ListLength(interp, argv[1], &len);
+    savedVect = Jim_Alloc(len*sizeof(Jim_Obj*));
+    for (i = 0; i < len; i++) {
+        Jim_ListIndex(interp, argv[1], i, &varNameObjPtr, JIM_NONE);
+        savedVect[i] = Jim_GetVariable(interp, varNameObjPtr, JIM_NONE);
+        if (savedVect[i] != NULL)
+            Jim_IncrRefCount(savedVect[i]);
+    }
+    /* Eval the body */
+    retCode = Jim_EvalObj(interp, argv[2]);
+    resultObjPtr = Jim_GetResult(interp);
+    Jim_IncrRefCount(resultObjPtr);
+    /* Restore the status of vars. */
+    for (i = 0; i < len; i++) {
+        Jim_ListIndex(interp, argv[1], i, &varNameObjPtr, JIM_NONE);
+        if (savedVect[i] != NULL) {
+            Jim_SetVariable(interp, varNameObjPtr, savedVect[i]);
+            Jim_DecrRefCount(interp, savedVect[i]);
+        } else {
+            Jim_UnsetVariable(interp, varNameObjPtr, JIM_NONE);
+        }
+    }
+    Jim_Free(savedVect);
+    /* Done */
+    Jim_SetResult(interp, resultObjPtr);
+    Jim_DecrRefCount(interp, resultObjPtr);
+    return retCode;
+}
 
 static struct {
     const char *name;
@@ -10816,6 +10855,7 @@ static struct {
     {"source", Jim_SourceCoreCommand},
     {"lreverse", Jim_LreverseCoreCommand},
     {"range", Jim_RangeCoreCommand},
+    {"scope", Jim_ScopeCoreCommand},
     {NULL, NULL},
 };
 
@@ -10884,7 +10924,7 @@ int Jim_InteractivePrompt(Jim_Interp *interp)
     printf("Welcome to Jim version %d.%d, "
            "Copyright (c) 2005 Salvatore Sanfilippo\n",
            JIM_VERSION / 100, JIM_VERSION % 100);
-    printf("CVS ID: $Id: jim.c,v 1.130 2005/03/26 14:12:32 antirez Exp $\n");
+    printf("CVS ID: $Id: jim.c,v 1.131 2005/03/28 16:57:36 antirez Exp $\n");
     Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
     while (1) {
         char buf[1024];
diff --git a/test.tcl b/test.tcl
index ac45d4c..9f0a312 100644
--- a/test.tcl
+++ b/test.tcl
@@ -1,4 +1,4 @@
-# $Id: test.tcl,v 1.26 2005/03/24 13:58:05 antirez Exp $
+# $Id: test.tcl,v 1.27 2005/03/28 16:57:36 antirez Exp $
 #
 # This are Tcl tests imported into Jim. Tests that will probably not be passed
 # in the long term are usually removed (for example all the tests about
@@ -28,8 +28,6 @@ proc test {id descr script expectedResult} {
     }
 }
 
-proc error {msg} { return -code error $msg }
-
 ################################################################################
 # SET
 ################################################################################
@@ -4140,6 +4138,62 @@ test range-5.0 {lindex llength range test} {
 } {164150}
 
 ################################################################################
+# SCOPE
+################################################################################
+test scope-1.0 {Non existing var} {
+    catch {unset x}
+    scope x {
+        set x 10
+        set y [+ $x 1]
+    }
+    list [info exists x] $y
+} {0 11}
+
+test scope-1.1 {Existing var restore} {
+    set x 100
+    scope x {
+        for {set x 0} {$x < 10} {incr x} {}
+    }
+    set x
+} {100}
+
+test scope-1.2 {Mix of 1.0 and 1.1 tests} {
+    catch {unset x}
+    set y 10
+    scope {x y} {
+        set y 100
+        set x 200
+    }
+    list [info exists x] $y
+} {0 10}
+
+test scope-1.3 {Array element} {
+    set x "a 1 b 2"
+    scope x(a) {
+        set x(a) Hello!
+    }
+    set x(a)
+} {1}
+
+test scope-1.4 {Non existing array element} {
+    catch {unset x}
+    scope x(a) {
+        set x(a) Hello!
+    }
+    info exists x(a)
+} {0}
+
+test scope-1.5 {Array element and var contaning the dict modifications} {
+    set x "a 1 b 2"
+    scope {x(a) x} {
+        set x "foo"
+    }
+    set x
+} {a 1 b 2}
+
+catch {unset y}
+
+################################################################################
 # JIM REGRESSION TESTS
 ################################################################################
 test regression-1.0 {Rename against procedures with static vars} {