Support basic $array(key) syntax, untodo tests.

partcl · Jun 25, 2010 · 9cde88d · 9cde88d
1 parent 0ae5973
commit 9cde88d
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 12 deletions.
diff --git a/src/Partcl/Actions.pm b/src/Partcl/Actions.pm
@@ -159,12 +159,23 @@ sub concat_atoms(@atoms) {
 ##  to point to the current lexical scope -- this simply
 ##  looks up the variable name in that lexpad and returns
 ##  the corresponding value.
-method variable:sym<scalar>($/) {
-    make PAST::Var.new( :scope<keyed>,
+
+method variable:sym<normal>($/) {
+    my $variable := PAST::Var.new( :scope<keyed>,
              PAST::Var.new( :name<lexpad>, :scope<register> ),
-             ~$<identifier>,
-             :node($/)
-         );
+             ~$<identifier>
+    );
+
+    if $<key> {
+        my $retval := PAST::Var.new( :scope<keyed>, 
+            $variable,
+            ~$<key>[0]
+        );
+        make $retval;
+    }
+    else {
+        make $variable;
+    }
 }
 
 method variable:sym<escaped>($/) {
@@ -175,8 +186,6 @@ method variable:sym<escaped>($/) {
          );
 }
 
-method variable:sym<array>($/) { make 'XXX';  }
-
 method integer($/) {
     if $<sign> eq '-' {
         make -1 * $<int>.ast;

diff --git a/src/Partcl/Grammar.pm b/src/Partcl/Grammar.pm
@@ -94,8 +94,8 @@ token list_atom:sym<chr> { <-[ \\ ]-space>+ }
 token identifier { <ident> ** '::' }
 
 proto token variable { <...> }
-token variable:sym<scalar>  { '$' <identifier> }
-token variable:sym<array>   { '$' <identifier> '(' <index=.bare> ')' }
+# XXX The key here is wrong. It needs to do variable interpolation, and more.
+token variable:sym<normal>  { '$' <identifier> [ '(' $<key>=(<-[)]>+) ')' ]? }
 token variable:sym<escaped> { '$' '{' $<identifier>=(<-[ } ]>*) '}' }
 
 rule integer { $<sign>=(<[+\-]>?)<int> }

diff --git a/t/cmd_array.t b/t/cmd_array.t
@@ -71,14 +71,14 @@ eval_is {
  catch {unset a}
  array set a [list a b c d e f]
  list $a(a) $a(c) $a(e)
-} {b d f} {array set multi list} {TODO NQPRX}
+} {b d f} {array set multi list}
 
 eval_is {
  catch {unset a}
  set a(a) b
  array set a [list c d e f]
  list $a(a) $a(c) $a(e)
-} {b d f} {array set preserve old values} {TODO NQPRX}
+} {b d f} {array set preserve old values}
 
 eval_is {
  catch {unset a}

diff --git a/t/tcl_var_subst.t b/t/tcl_var_subst.t
@@ -31,7 +31,7 @@ eval_is {
    catch {unset a}
    set a(b) whee
    set b $a(b)
-} whee {array, entire word} {TODO NQPRX}
+} whee {array, entire word}
 
 eval_is {
   catch {unset a}