make [info args] ignore default values.

partcl · Jul 11, 2010 · c66fcf1 · c66fcf1
1 parent 7dbeac1
commit c66fcf1
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 4 deletions.
diff --git a/src/Partcl/commands/main.pm b/src/Partcl/commands/main.pm
@@ -417,8 +417,9 @@ our sub proc(*@args) {
 
     my $parse :=
         Partcl::Grammar.parse( $body, :rule<TOP_proc>, :actions(Partcl::Actions) );
-    my $block := $parse.ast;
-    my @params  := $args.getList();
+    my $block    := $parse.ast;
+    my @params   := $args.getList();
+    my @argsInfo := pir::new__Ps('TclList');
 
     for @params {
         my @argument := $_.getList();
@@ -433,6 +434,7 @@ our sub proc(*@args) {
                     PAST::Var.new( :scope<parameter> )
                 )
             );
+            @argsInfo.push($_);
         } elsif +@argument == 2 {
             $block[0].push(
                 PAST::Op.new( :pasttype<bind>,
@@ -446,13 +448,14 @@ our sub proc(*@args) {
                     )
                 )
             );
+            @argsInfo.push(@argument[0]);
         }
     }
     $block.name($name);
     $block.control('return_pir');
     PAST::Compiler.compile($block);
     my $thing := pir::get_hll_global__PS($name);
-    pir::setprop($thing, 'args', @params);
+    pir::setprop($thing, 'args', @argsInfo);
     '';
 }
 

diff --git a/t/cmd_info.t b/t/cmd_info.t
@@ -41,7 +41,7 @@ eval_is {
 eval_is {
   proc foo {a {b 2}} {puts a; puts b}
   info args foo
-} {a b} {info args default args} {TODO NQPRX}
+} {a b} {info args default args}
 
 eval_is {
   info body