Author: smash
Date: Tue Feb 13 08:42:21 2007
New Revision: 16967

Modified:
   trunk/languages/tcl/runtime/builtin/file.pir
   trunk/languages/tcl/t/cmd_file.t

Log:
[tcl]
* implement [file dirname], check RT#40722 for details
  + added very simple tests


Modified: trunk/languages/tcl/runtime/builtin/file.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/file.pir        (original)
+++ trunk/languages/tcl/runtime/builtin/file.pir        Tue Feb 13 08:42:21 2007
@@ -378,10 +378,54 @@
   tcl_error 'wrong # args: should be "file mtime name ?time?"'
 .end
 
-# RT#40722: Stub for test parsing
+# RT#40722: needs windows OS testing
 .sub 'dirname'
-  .param pmc argv
-  .return(0)
+    .param pmc argv
+
+    .local int argc
+    argc = elements argv
+    if argc != 1 goto bad_args
+
+    .local string filename
+    filename = argv[0]
+
+    .local string separator
+    $P0 = get_root_global ['_tcl'], 'slash'
+    separator = $P0
+
+    $S0 = substr filename, -1, 1
+    if $S0 != separator goto continue
+    chopn filename, 1
+
+  continue:
+    .local pmc array
+    array = split separator, filename
+    $S0 = pop array
+    unless $S0 == '' goto skip
+    push array, $S0
+
+  skip:
+    $I0 = elements array
+    if $I0 == 0 goto empty
+
+    $P1 = new .ResizableStringArray
+  loop:
+    unless array goto done
+    $S0 = shift array
+    if $S0 == '' goto loop
+    push $P1, $S0
+    goto loop
+
+  done:
+    $S0 = join separator, $P1
+    $S1 = concat separator, $S0 # guessing that this won't be needed in win
+    .return($S1)
+
+  empty:
+    .return('.')
+
+  bad_args:
+    tcl_error 'wrong # args: should be "file dirname name"'
 .end
 
 # RT#40723: Stub (unixy)

Modified: trunk/languages/tcl/t/cmd_file.t
==============================================================================
--- trunk/languages/tcl/t/cmd_file.t    (original)
+++ trunk/languages/tcl/t/cmd_file.t    Tue Feb 13 08:42:21 2007
@@ -8,7 +8,7 @@
 
 source lib/test_more.tcl
 
-plan 9 ;# from outer space. (HAH!)
+plan 13 ;# from outer space. (HAH!)
 
 # [file exists]
 eval_is {file exists} \
@@ -42,3 +42,18 @@
 
 is [file rootname f..i.le.ext] f..i.le \
   {[file rootname] filename with dots and extension}
+
+# [file dirname]
+eval_is {file dirname} \
+  {wrong # args: should be "file dirname name"} \
+  {[file dirname] too few args}
+eval_is {file dirname foo bar} \
+  {wrong # args: should be "file dirname name"} \
+  {[file dirname] too many args}
+
+is [file dirname .] .  \
+  {[file dirname] dirname dot}
+
+is [file dirname file.ext] .  \
+  {[file dirname] dirname simple file}
+

Reply via email to