fixup [unset] enough to run the test file.

partcl · Jul 1, 2010 · 84cc2b4 · 84cc2b4
1 parent 18945e6
commit 84cc2b4
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 19 deletions.
diff --git a/build/Makefile.in b/build/Makefile.in
@@ -106,6 +106,7 @@ TEST_FILES = \
   t/cmd_switch.t \
   t/cmd_time.t \
   t/cmd_trace.t \
+  t/cmd_unset.t \
   t/cmd_upvar.t \
   t/cmd_variable.t \
   t/cmd_vwait.t \
@@ -119,8 +120,7 @@ TEST_FILES = \
 
 # These t/*.t files are not yet runnable. Keep a list around so we know
 # what to work on.
-# t/cmd_expr.t  t/cmd_namespace.t t/cmd_proc.t
-# t/cmd_unset.t t/tcl_namespace.t
+# t/cmd_expr.t  t/cmd_namespace.t t/cmd_proc.t t/tcl_namespace.t
 
 Makefile: Configure.pl build/Makefile.in
 	$(PERL) Configure.pl

diff --git a/src/Partcl/commands/main.pm b/src/Partcl/commands/main.pm
@@ -521,7 +521,7 @@ our sub set(*@args) {
         my $keyname   := pir::substr__ssii($varname, $left_paren+1, $right_paren-$left_paren-1);
         my $arrayname := pir::substr__ssii($varname, 0, $left_paren);
 
-        if pir::defined($value) { # set
+        if +@args == 2 { # set
             my $var := Q:PIR {
                 .local pmc varname, lexpad
                 varname = find_lex '$arrayname'
@@ -687,11 +687,23 @@ our sub time(*@args) {
 }
 
 our sub unset(*@args) {
+    my $lexpad := pir::find_dynamic_lex('%LEXPAD');
+    my $quiet  := 0;
+    if +@args && @args[0] eq '-nocomplain' {
+        $quiet := 1;
+        @args.shift();
+    }
     for @args -> $varname {
-        Q:PIR {
-            $P1 = find_lex '$varname'
-            $P2 = find_dynamic_lex '%LEXPAD'
-            delete $P2[$P1]
+        my $var := $lexpad{$varname};
+        if !pir::defined($var) {
+            error("can't unset \"$varname\": no such variable")
+                unless $quiet;
+        }  else {
+            Q:PIR {
+                $P1 = find_lex '$lexpad'
+                $P2 = find_lex '$varname'
+                delete $P1[$P2]
+            }
         }
     }
     '';

diff --git a/t/cmd_unset.t b/t/cmd_unset.t
@@ -24,20 +24,20 @@ eval_is {
  unset a(2)
  puts $a(2)
 } {can't read "a(2)": no such element in array} \
-  {set/unset array element}
+  {set/unset array element} {TODO NQPRX}
 
 eval_is {
  set b(2) 2
  unset b
  set b(2)
 } {can't read "b(2)": no such variable} \
-  {set/unset array}
+  {set/unset array} {TODO NQPRX}
 
 eval_is {
  set c(1) 1
  unset c(2)
 } {can't unset "c(2)": no such element in array} \
-  {unset missing array element}
+  {unset missing array element} {TODO NQPRX}
 
 eval_is {unset d(2)} \
   {can't unset "d(2)": no such variable} \
@@ -55,7 +55,7 @@ eval_is {
  set -nocomplain 2
  unset -- -nocomplain
  info exists -nocomplain
-} 0 {unset -- -nocomplain}
+} 0 {unset -- -nocomplain} {TODO NQPRX}
 
 eval_is {
  set -nocomplain 2
@@ -70,7 +70,7 @@ eval_is {
   set -- 2
   unset -nocomplain -- foo
   set --
-} 2 {unset -nocomplain -- foo}
+} 2 {unset -nocomplain -- foo} {TODO NQPRX}
 
 eval_is {
   set foo 2
@@ -94,7 +94,7 @@ eval_is {
   unset b
   set a
 } {can't read "a": no such variable} \
-  {unset upvar}
+  {unset upvar} {TODO NQPRX}
 
 eval_is {
   catch {unset a}
@@ -103,7 +103,7 @@ eval_is {
   test
   set a
 } {can't read "a": no such variable} \
-  {unset global}
+  {unset global} {TODO NQPRX}
 
 eval_is {
   catch {unset a}
@@ -112,7 +112,7 @@ eval_is {
   unset b
   set b 2
   set a
-} 2 {reset an unset upvar}
+} 2 {reset an unset upvar} {TODO NQPRX}
 
 eval_is {
   catch {unset array}
@@ -121,7 +121,7 @@ eval_is {
   unset elem
   set elem 7
   set array(a)
-} 7 {reset an unset array elem upvar}
+} 7 {reset an unset array elem upvar} {TODO NQPRX}
 
 eval_is {
   catch {unset array}
@@ -130,7 +130,7 @@ eval_is {
   unset elem
   set array(a)
 } {can't read "array(a)": no such element in array} \
-  {unset array elem upvar}
+  {unset array elem upvar} {TODO NQPRX}
 
 eval_is {
   catch {unset array}
@@ -139,13 +139,13 @@ eval_is {
   unset array(b)
   set c
 } {variable "c" already exists} \
-  {unset an aliased array elem}
+  {unset an aliased array elem} {TODO NQPRX}
 
 eval_is {
   catch {unset a}
   set a 55
   unset a(f)
 } {can't unset "a(f)": variable isn't array} \
-  {variable isn't array}
+  {variable isn't array} {TODO NQPRX}
 
 # vim: filetype=tcl: