Author: fperrad
Date: Tue Apr 17 04:43:28 2007
New Revision: 18261
Modified:
trunk/languages/lua/lib/lfs.pir
trunk/languages/lua/t/lfs.t
Log:
[Lua]
- implement chdir, currentdir, mkdir & rmdir
- and tests
Modified: trunk/languages/lua/lib/lfs.pir
==============================================================================
--- trunk/languages/lua/lib/lfs.pir (original)
+++ trunk/languages/lua/lib/lfs.pir Tue Apr 17 04:43:28 2007
@@ -205,14 +205,33 @@
Returns C<true> in case of success or C<nil> plus an error string.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lfs_chdir' :anon
.param pmc path :optional
+ .local pmc ret
$S1 = checkstring(path)
- not_implemented()
+ $S0 = $S1
+ new $P0, .OS
+ push_eh _handler
+ $P0.'chdir'($S1)
+ new ret, .LuaBoolean
+ set ret, 1
+ .return (ret)
+_handler:
+ .local pmc nil
+ .local pmc msg
+ .local pmc e
+ .local string s
+ .get_results (e, s)
+ new nil, .LuaNil
+ new msg, .LuaString
+ $S0 = concat "Unable to change working directory to '", $S0
+ $S0 = concat "'\n"
+ $S0 = concat s
+ $S0 = concat "\n"
+ set msg, $S0
+ .return (nil, msg)
.end
@@ -221,12 +240,26 @@
Returns a string with the current working directory or C<nil> plus an error
string.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lfs_currentdir' :anon
- not_implemented()
+ .local pmc ret
+ new $P0, .OS
+ push_eh _handler
+ $S0 = $P0.'cwd'()
+ new ret, .LuaString
+ set ret, $S0
+ .return (ret)
+_handler:
+ .local pmc nil
+ .local pmc msg
+ .local pmc e
+ .local string s
+ .get_results (e, s)
+ new nil, .LuaNil
+ new msg, .LuaString
+ set msg, s
+ .return (nil, msg)
.end
@@ -282,14 +315,30 @@
Returns C<true> if the operation was successful; in case of error, it returns
C<nil> plus an error string.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lfs_mkdir' :anon
.param pmc dirname :optional
+ .local pmc ret
$S1 = checkstring(dirname)
- not_implemented()
+ $S0 = $S1
+ new $P0, .OS
+ push_eh _handler
+ $I1 = 0o775
+ $P0.'mkdir'($S1, $I1)
+ new ret, .LuaBoolean
+ set ret, 1
+ .return (ret)
+_handler:
+ .local pmc nil
+ .local pmc msg
+ .local pmc e
+ .local string s
+ .get_results (e, s)
+ new nil, .LuaNil
+ new msg, .LuaString
+ set msg, s
+ .return (nil, msg)
.end
@@ -300,14 +349,29 @@
Returns C<true> if the operation was successful; in case of error, it returns
C<nil> plus an error string.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lfs_rmdir' :anon
.param pmc dirname :optional
+ .local pmc ret
$S1 = checkstring(dirname)
- not_implemented()
+ $S0 = $S1
+ new $P0, .OS
+ push_eh _handler
+ $P0.'rm'($S1)
+ new ret, .LuaBoolean
+ set ret, 1
+ .return (ret)
+_handler:
+ .local pmc nil
+ .local pmc msg
+ .local pmc e
+ .local string s
+ .get_results (e, s)
+ new nil, .LuaNil
+ new msg, .LuaString
+ set msg, s
+ .return (nil, msg)
.end
Modified: trunk/languages/lua/t/lfs.t
==============================================================================
--- trunk/languages/lua/t/lfs.t (original)
+++ trunk/languages/lua/t/lfs.t Tue Apr 17 04:43:28 2007
@@ -22,15 +22,11 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test;
+use Parrot::Test tests => 9;
use Test::More;
-
-if ( exists $ENV{PARROT_LUA_TEST_PROG} ) {
- plan skip_all => "parrot only";
-}
-else {
- plan tests => 1;
-}
+use Cwd;
+use File::Basename;
+use File::Spec;
language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'require lfs' );
require "lfs"
@@ -41,6 +37,91 @@
LuaFileSystem 1.2
OUTPUT
+my $cwd = dirname(File::Spec->canonpath(getcwd));
+language_output_is( 'lua', << 'CODE', << "OUTPUT", 'function lfs.currentdir' );
+require "lfs"
+print(lfs.currentdir())
+CODE
+$cwd
+OUTPUT
+
+my $upcwd = File::Spec->catfile($cwd, 'src');
+language_output_is( 'lua', << 'CODE', << "OUTPUT", 'function lfs.chdir' );
+require "lfs"
+print(lfs.chdir("src"))
+print(lfs.currentdir())
+print(lfs.chdir(".."))
+print(lfs.currentdir())
+CODE
+true
+$upcwd
+true
+$cwd
+OUTPUT
+
+language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function lfs.chdir' );
+require "lfs"
+r, msg = lfs.chdir("bad_dir")
+print(r)
+print(msg)
+CODE
+nil
+Unable to change working directory to 'bad_dir'
+No such file or directory
+
+OUTPUT
+
+my $xpto = File::Spec->catfile($cwd, 'xpto');
+language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
+require "lfs"
+print(lfs.mkdir("xpto"))
+print(lfs.chdir("xpto"))
+print(lfs.currentdir())
+print(lfs.chdir(".."))
+print(lfs.currentdir())
+CODE
+true
+true
+$xpto
+true
+$cwd
+OUT
+
+rmdir '../xpto' if (-d '../xpto');
+
+language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
+require "lfs"
+r, msg = lfs.mkdir("xptoo/xptoo")
+print(r)
+print(msg)
+CODE
+nil
+No such file or directory
+OUT
+
+mkdir '../xpto' unless -d '../xpto';
+
+language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
+require "lfs"
+print(lfs.rmdir("xpto"))
+CODE
+true
+OUT
+
+ok( !-d $xpto, "Test that rm removed the directory" );
+rmdir '../xpto' if (-d '../xpto');
+
+language_output_is( 'lua', <<'CODE', <<"OUT", 'function lfs.mkdir' );
+require "lfs"
+r, msg = lfs.rmdir("xpto")
+print(r)
+print(msg)
+CODE
+nil
+No such file or directory
+OUT
+
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
