Author: fperrad
Date: Wed Apr 18 00:13:17 2007
New Revision: 18278
Modified:
trunk/languages/lua/lib/lfs.pir
trunk/languages/lua/lib/luaaux.pir
trunk/languages/lua/t/lfs.t
Log:
[Lua]
- implement lfs.dir
- and tests
Modified: trunk/languages/lua/lib/lfs.pir
==============================================================================
--- trunk/languages/lua/lib/lfs.pir (original)
+++ trunk/languages/lua/lib/lfs.pir Wed Apr 18 00:13:17 2007
@@ -110,8 +110,14 @@
.sub 'check_file' :anon
.param pmc fh
+ .param string funcname
.local pmc ret
- ret = getattribute fh, 'data'
+ checkudata(fh, 'ParrotIO')
+ ret = getattribute fh, 'data'
+ unless null ret goto L1
+ $S0 = concat funcname, ": closed file"
+ error($S0)
+L1:
.return (ret)
.end
@@ -269,14 +275,41 @@
called it returns a string with an entry of the directory; C<nil> is returned
when there is no more entries. Raises an error if C<path> is not a directory.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lfs_dir' :anon
.param pmc path :optional
+ .local pmc ret
$S1 = checkstring(path)
- not_implemented()
+ $S0 = $S1
+ new $P0, .OS
+ push_eh _handler
+ $P1 = $P0.'readdir'($S1)
+ .lex 'upvar_dir', $P1
+ .const .Sub dir_aux = 'dir_aux'
+ ret = newclosure dir_aux
+ .return (ret)
+_handler:
+ .local pmc e
+ .local string s
+ .get_results (e, s)
+ $S0 = concat "cannot open ", $S0
+ $S0 = concat ": "
+ $S0 = concat s
+ error($S0)
+.end
+
+.sub 'dir_aux' :anon :lex :outer(_lfs_dir)
+ .local pmc ret
+ $P1 = find_lex 'upvar_dir'
+ unless $P1 goto L1
+ $S1 = shift $P1
+ new ret, .LuaString
+ set ret, $S1
+ .return (ret)
+L1:
+ new ret, .LuaNil
+ .return (ret)
.end
@@ -300,7 +333,7 @@
.param pmc mode :optional
.param pmc start :optional
.param pmc length :optional
- $P1 = check_file(filehandle)
+ $P1 = check_file(filehandle, 'lock')
$S2 = checkstring(mode)
$I3 = optint(start, 0)
$I4 = optint(length, 0)
@@ -321,7 +354,6 @@
.param pmc dirname :optional
.local pmc ret
$S1 = checkstring(dirname)
- $S0 = $S1
new $P0, .OS
push_eh _handler
$I1 = 0o775
@@ -355,7 +387,6 @@
.param pmc dirname :optional
.local pmc ret
$S1 = checkstring(dirname)
- $S0 = $S1
new $P0, .OS
push_eh _handler
$P0.'rm'($S1)
@@ -419,7 +450,7 @@
.param pmc filehandle :optional
.param pmc start :optional
.param pmc length :optional
- $P1 = check_file(filehandle)
+ $P1 = check_file(filehandle, 'unlock')
$I2 = optint(start, 0)
$I3 = optint(length, 0)
not_implemented()
Modified: trunk/languages/lua/lib/luaaux.pir
==============================================================================
--- trunk/languages/lua/lib/luaaux.pir (original)
+++ trunk/languages/lua/lib/luaaux.pir Wed Apr 18 00:13:17 2007
@@ -87,7 +87,7 @@
unless $I0 goto L0
.return ($P0)
L0:
- tag_error($S0, "number")
+ typerror($S0, "number")
.end
@@ -140,7 +140,7 @@
val = arg.'tostring'()
.return (val)
L0:
- tag_error($S0, "string")
+ typerror($S0, "string")
.end
@@ -157,7 +157,33 @@
if $S0 != type goto L0
.return ()
L0:
- tag_error($S0, type)
+ typerror($S0, type)
+.end
+
+
+=item C<checkudata (arg, type)>
+
+=cut
+
+.sub 'checkudata'
+ .param pmc arg
+ .param string type
+ $S0 = "no value"
+ if null arg goto L0
+ $S0 = typeof arg
+ $I0 = isa arg, 'LuaUserdata'
+ unless $I0 goto L0
+ .local pmc _lua__REGISTRY
+ .local pmc key
+ _lua__REGISTRY = global '_REGISTRY'
+ new key, .LuaString
+ set key, type
+ $P0 = _lua__REGISTRY[key]
+ $P1 = arg.'get_metatable'()
+ unless $P0 == $P1 goto L0
+ .return ()
+L0:
+ typerror($S0, type)
.end
@@ -427,11 +453,11 @@
.end
-=item C<tag_error (got, expec)>
+=item C<typerror (got, expec)>
=cut
-.sub 'tag_error'
+.sub 'typerror'
.param string got
.param string expec
$S0 = expec
Modified: trunk/languages/lua/t/lfs.t
==============================================================================
--- trunk/languages/lua/t/lfs.t (original)
+++ trunk/languages/lua/t/lfs.t Wed Apr 18 00:13:17 2007
@@ -22,7 +22,7 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 12;
use Test::More;
use Cwd;
use File::Basename;
@@ -87,6 +87,16 @@
$cwd
OUT
+language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.dir' );
+require "lfs"
+for file in lfs.dir("xpto") do
+ print(file)
+end
+CODE
+.
+..
+OUT
+
rmdir '../xpto' if (-d '../xpto');
language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
@@ -99,6 +109,13 @@
No such file or directory
OUT
+language_output_like( 'lua', <<'CODE', <<"OUT", 'function lfs.dir' );
+require "lfs"
+lfs.dir("xptoo")
+CODE
+/cannot open xptoo: No such file or directory/
+OUT
+
mkdir '../xpto' unless -d '../xpto';
language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
@@ -121,6 +138,21 @@
No such file or directory
OUT
+unlink('../file.txt') if ( -f '../file.txt' );
+open my $X, '>', '../file.txt';
+binmode $X, ':raw';
+print {$X} "file with text\n";
+close $X;
+
+language_output_like( 'lua', <<'CODE', <<"OUT", 'function lfs.lock (closed)' );
+require "lfs"
+f = io.open("file.txt")
+f:close()
+lfs.lock(f)
+CODE
+/lock: closed file/
+OUT
+
# Local Variables:
# mode: cperl
