Author: fperrad
Date: Mon Jan 9 00:06:21 2006
New Revision: 11009
Modified:
trunk/languages/lua/lib/luaos.pir
trunk/languages/lua/lib/luapir.pir
trunk/languages/lua/t/lib/os.t
Log:
Lua:
- add function time
- more tests
Modified: trunk/languages/lua/lib/luaos.pir
==============================================================================
--- trunk/languages/lua/lib/luaos.pir (original)
+++ trunk/languages/lua/lib/luaos.pir Mon Jan 9 00:06:21 2006
@@ -1,4 +1,4 @@
-# Copyright: 2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
# $Id$
=head1 NAME
@@ -104,6 +104,8 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_clock :anon
+ .local pmc ret
+ new ret, .LuaNumber
not_implemented()
.end
@@ -135,6 +137,10 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_date :anon
+ .param pmc format :optional
+ .param pmc time :optional
+ $S0 = optstring(format, "%c")
+ $I0 = optint(time, -1)
not_implemented()
.end
@@ -148,6 +154,10 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_difftime :anon
+ .param pmc t2
+ .param pmc t1
+ $I0 = checkint(t2)
+ $I1 = optint(t1, 0)
not_implemented()
.end
@@ -246,6 +256,10 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_rename :anon
+ .param pmc oldname
+ .param pmc newname
+ $S0 = checkstring(oldname)
+ $S1 = checkstring(newname)
not_implemented()
.end
@@ -262,6 +276,9 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_setlocale :anon
+ .param pmc locale
+ .param pmc category :optional
+ $S1 = optstring(category, "all")
not_implemented()
.end
@@ -278,11 +295,23 @@ seconds since some given start time (the
meaning is not specified, and the number returned by C<time> can be used only
as an argument to C<date> and C<difftime>.
-NOT YET IMPLEMENTED.
+STILL INCOMPLETE.
=cut
.sub _os_time :anon
+ .param pmc table :optional
+ .local pmc ret
+ if_null table, L0
+ $S0 = typeof table
+ if $S0 != "nil" goto L1
+L0:
+ $I0 = time
+ new ret, .LuaNumber
+ ret = $I0
+ .return (ret)
+L1:
+ checktype(table, "table")
not_implemented()
.end
@@ -301,6 +330,8 @@ NOT YET IMPLEMENTED.
=cut
.sub _os_tmpname :anon
+ .local pmc ret
+ new ret, .LuaString
not_implemented()
.end
Modified: trunk/languages/lua/lib/luapir.pir
==============================================================================
--- trunk/languages/lua/lib/luapir.pir (original)
+++ trunk/languages/lua/lib/luapir.pir Mon Jan 9 00:06:21 2006
@@ -1,4 +1,4 @@
-# Copyright: 2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
# $Id$
=head1 NAME
@@ -45,9 +45,17 @@ L1:
.sub checknumber
.param pmc arg
.local float val
+ $S0 = "no value"
+ if_null arg, L0
+ $S0 = typeof arg
+# print $S0
+# print "\n"
+ if $S0 == "nil" goto L0
val = arg
# TODO
.return (val)
+L0:
+ tag_error($S0, "number")
.end
=item C<checkstring (arg)>
@@ -62,6 +70,22 @@ L1:
.return (val)
.end
+=item C<checktype (arg, type)>
+
+=cut
+
+.sub checktype
+ .param pmc arg
+ .param string type
+ $S0 = "no value"
+ if_null arg, L0
+ $S0 = typeof arg
+ if $S0 != type goto L0
+ .return ()
+L0:
+ tag_error($S0, type)
+.end
+
=item C<error (message)>
=cut
@@ -74,6 +98,15 @@ L1:
throw ex
.end
+=item C<getn (table)>
+
+=cut
+
+.sub getn
+ .param pmc table
+ not_implemented()
+.end
+
=item C<not_implemented ()>
=cut
@@ -117,6 +150,16 @@ L0:
.return (default)
.end
+=item C<setn (table, n)>
+
+=cut
+
+.sub setn
+ .param pmc table
+ .param int n
+ not_implemented()
+.end
+
#.sub tostring
# .param pmc arg
# .local string str
@@ -126,6 +169,19 @@ L0:
# .return (str)
#.end
+=item C<tag_error (got, expec)>
+
+=cut
+
+.sub tag_error
+ .param string got
+ .param string expec
+ $S0 = expec
+ concat $S0, " expected, got "
+ concat $S0, got
+ argerror($S0)
+.end
+
=back
=head1 AUTHORS
Modified: trunk/languages/lua/t/lib/os.t
==============================================================================
--- trunk/languages/lua/t/lib/os.t (original)
+++ trunk/languages/lua/t/lib/os.t Mon Jan 9 00:06:21 2006
@@ -1,5 +1,5 @@
#! perl -w
-# Copyright: 2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
# $Id$
=head1 NAME
@@ -18,7 +18,7 @@ Tests Lua Operating System Library
=cut
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 7;
use Test::More;
pir_output_is(<< 'CODE', << 'OUTPUT', "function execute");
@@ -53,6 +53,34 @@ test
2
OUTPUT
+pir_output_is(<< 'CODE', << 'OUTPUT', "function exit");
+.namespace [ "Lua" ]
+.HLL "Lua", "lua_group"
+.sub _main
+ load_bytecode "languages/lua/lib/luaos.pbc"
+ .local pmc _G
+ _G = global "_G"
+ .local pmc key1
+ key1 = new .LuaString
+ key1 = "os"
+ .local pmc os
+ os = new .LuaTable
+ os = _G[key1]
+ .local pmc key2
+ key2 = new .LuaString
+ key2 = "exit"
+ .local pmc fct1
+ fct1 = os[key2]
+ .local pmc ret1
+ print "reached\n"
+ fct1()
+ print "not reached\n"
+ end
+.end
+CODE
+reached
+OUTPUT
+
pir_output_is(<< 'CODE', << 'OUTPUT', "function getenv");
.namespace [ "Lua" ]
.HLL "Lua", "lua_group"
@@ -164,3 +192,33 @@ nil
file.rm: No such file or directory
OUTPUT
+pir_output_is(<< 'CODE', << 'OUTPUT', "function time");
+.namespace [ "Lua" ]
+.HLL "Lua", "lua_group"
+.sub _main
+ load_bytecode "languages/lua/lib/luaos.pbc"
+ .local pmc _G
+ _G = global "_G"
+ .local pmc key1
+ key1 = new .LuaString
+ key1 = "os"
+ .local pmc os
+ os = new .LuaTable
+ os = _G[key1]
+ .local pmc key2
+ key2 = new .LuaString
+ key2 = "time"
+ .local pmc fct1
+ fct1 = os[key2]
+ .local pmc ret1
+ (ret1) = fct1()
+ $I0 = time
+ unless ret1 == $I0 goto L0
+ print "ok\n"
+L0:
+ end
+.end
+CODE
+ok
+OUTPUT
+
