Hi all,
This patch implements the first version of file ext for tcl. I am not
sure if it's supposed to be [file ext] or [file extension], i kept the
stub sub name 'ext' and so pushed 'ext' to the options
ResizablePMCArray. Feel free to change this.
It wasn't possible to test this using the test files, so i "hand made"
some tests using make tclsh:
% file ext
wrong # args: should be "file ext name"
% file ext abc.ddd
.ddd
% file ext foo
% file ext foo.bar
.bar
% file ext .bar
.bar
% file ext aaa.bbb.ccc.bar
.bar
% file ext .
.
% file ext aaa/bbb/ccc.foo
.foo
% file ext aaa\bbb\ccc.foo
.foo
% file ext aaa\aa.bb/ccc.dd
.dd
% file ext abc abc
wrong # args: should be "file ext name"
% file ext foo......bar
.bar
We can check for more stuff when we're able to use the test suit.
Files affected:
languages/tcl/runtime/builtin/file.pir
Best regards,
./smash
Index: languages/tcl/runtime/builtin/file.pir
===================================================================
--- languages/tcl/runtime/builtin/file.pir (revision 15876)
+++ languages/tcl/runtime/builtin/file.pir (working copy)
@@ -23,6 +23,7 @@
push options, 'executable'
push options, 'exists'
push options, 'extension'
+ push options, 'ext'
push options, 'isdirectory'
push options, 'isfile'
push options, 'join'
@@ -438,8 +439,33 @@
# RT#40729: Stub for test parsing
.sub 'ext'
- .param pmc argv
- .return(0)
+ .param pmc argv
+ .local int argc
+
+ # check if filename arg exists
+ argc = elements argv
+ if argc != 1 goto bad_args
+
+ # get our filename
+ $S0 = argv[0]
+
+ # test if filename has dots
+ $I0 = index $S0, '.'
+ if $I0 == -1 goto no_dot
+
+ # calculate file extension
+ $P0 = split '.', $S0
+ $S1 = pop $P0
+ # include dot
+ $S1 = '.' . $S1
+
+ .return($S1)
+
+ no_dot:
+ .return('')
+
+ bad_args:
+ tcl_error 'wrong # args: should be "file ext name"'
.end
# XXX: Stub
