fix [append]'s handling of non-existant variables.

partcl · Jun 27, 2010 · 228ffd4 · 228ffd4
1 parent 62253f0
commit 228ffd4
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 4 deletions.
diff --git a/src/Partcl/commands/main.pm b/src/Partcl/commands/main.pm
@@ -11,14 +11,30 @@ our sub append(*@args) {
         error('wrong # args: should be "append varName ?value value ...?"');
     }
 
-    my $var := @args.shift;
+    my $varName := @args.shift;
+
+    my $var;
+
+    # XXX bug compatibility - tcl errors if the var doesn't exist and there
+    # is nothing to append. See test file for ticket #. 
+
+    if !+@args {
+        $var := set($varName);
+    } else {
+        $var := Q:PIR {
+            .local pmc varname, lexpad
+            varname = find_lex '$varName'
+            lexpad = find_dynamic_lex '%LEXPAD'
+            %r = vivify lexpad, varname, ['TclString']
+        };
+    }
 
-    my $result := set($var);
+    my $result := set($varName);
     while @args {
         $result := ~$result ~ @args.shift;
     }
 
-    set($var, $result);
+    set($varName, $result);
 }
 
 our sub apply(*@args) {

diff --git a/t/cmd_append.t b/t/cmd_append.t
@@ -15,7 +15,7 @@ is [set x ""; append x 1 2 abc "long string"] \
 eval_is {
   catch {unset x}
   append x 1 2 abc "long string"
-} {12abclong string} {unset variable} {TODO NQPRX}
+} {12abclong string} {unset variable}
 
 eval_is {append} \
   {wrong # args: should be "append varName ?value value ...?"} \