Author: fperrad
Date: Mon Apr 2 23:16:33 2007
New Revision: 17954
Modified:
trunk/languages/lua/Lua/build.pm
trunk/languages/lua/Lua/lua51.yp
trunk/languages/lua/Lua/opcode.pm
trunk/languages/lua/Lua/parser.pm
trunk/languages/lua/Lua/pir.pm
trunk/languages/lua/lib/alarm.pir
trunk/languages/lua/lib/luaaux.pir
trunk/languages/lua/lib/luabasic.pir
trunk/languages/lua/lib/luacoroutine.pir
trunk/languages/lua/lib/luadebug.pir
trunk/languages/lua/lib/luaio.pir
trunk/languages/lua/lib/luamath.pir
trunk/languages/lua/lib/luaos.pir
trunk/languages/lua/lib/luapackage.pir
trunk/languages/lua/lib/luastring.pir
trunk/languages/lua/lib/luatable.pir
trunk/languages/lua/pmc/luaclosure.pmc
trunk/languages/lua/pmc/luafunction.pmc
trunk/languages/lua/pmc/luatable.pmc
trunk/languages/lua/t/basic.t
trunk/languages/lua/t/debug.t
Log:
[Lua]
- implement Lua environment
- add setfenv, getfenv, debug.setfenv & debug.getfenv
- and add tests
Modified: trunk/languages/lua/Lua/build.pm
==============================================================================
--- trunk/languages/lua/Lua/build.pm (original)
+++ trunk/languages/lua/Lua/build.pm Mon Apr 2 23:16:33 2007
@@ -30,24 +30,37 @@
return new defn( $idf, 'fct' );
}
-sub get_global {
+sub get_environ {
my ($parser) = @_;
my @opcodes = ();
- unless ( $parser->YYData->{_G} ) {
- $parser->YYData->{_G} = new_tmp( $parser, 'pmc' );
+ my $env = new defn( 'env', 'tmp', 'pmc' );
+ unless ($parser->YYData->{sub}) {
+ my $sub = new_tmp( $parser, 'pmc' );
push @opcodes, new LocalDir(
$parser,
'prolog' => 1,
- 'result' => $parser->YYData->{_G},
+ 'result' => $sub,
);
- push @opcodes, new GetGlobalOp(
+ push @opcodes, new InterpInfoOp(
$parser,
'prolog' => 1,
- 'result' => $parser->YYData->{_G},
- 'arg1' => '_G',
+ 'result' => $sub,
+ 'arg1' => '.INTERPINFO_CURRENT_SUB',
);
+ push @opcodes, new LocalDir(
+ $parser,
+ 'prolog' => 1,
+ 'result' => $env,
+ );
+ $parser->YYData->{sub} = $sub;
}
- return [ $parser->YYData->{_G}, [EMAIL PROTECTED] ];
+ push @opcodes, new CallMethOp(
+ $parser,
+ 'result' => [ $env ],
+ 'arg1' => 'getfenv',
+ 'arg2' => [ $parser->YYData->{sub} ],
+ );
+ return [ $env, [EMAIL PROTECTED] ];
}
sub get_cond {
@@ -66,8 +79,8 @@
my ($parser) = @_;
PushScope($parser);
- push @{ $parser->YYData->{scope} }, $parser->YYData->{_G};
- $parser->YYData->{_G} = undef;
+ push @{ $parser->YYData->{scope} }, $parser->YYData->{sub};
+ $parser->YYData->{sub} = undef;
unshift @{ $parser->YYData->{scopef} }, $parser->YYData->{symbtab_cst};
$parser->YYData->{symbtab_cst} = new SymbTabConst($parser);
unshift @{ $parser->YYData->{scopef} }, $parser->YYData->{scope};
@@ -91,8 +104,8 @@
$parser->YYData->{scope} = $scope;
my $symbtab = shift @{ $parser->YYData->{scopef} };
$parser->YYData->{symbtab_cst} = $symbtab;
- my $g = pop @{ $parser->YYData->{scope} };
- $parser->YYData->{_G} = $g;
+ my $sub = pop @{ $parser->YYData->{scope} };
+ $parser->YYData->{sub} = $sub;
## warn "PopScopeF\n";
PopScope($parser);
return;
@@ -392,11 +405,11 @@
else {
# global variable
- my $global = get_global($parser);
- push @opcodes, @{ $global->[1] };
+ my $env = get_environ($parser);
+ push @opcodes, @{ $env->[1] };
my $key = BuildLiteral( $parser, $idf, 'key' );
push @opcodes, @{ $key->[1] };
- my $result = $global->[0];
+ my $result = $env->[0];
foreach my $key2 ( @{$var} ) {
my $result2 = new_tmp( $parser, 'pmc' );
push @opcodes, new LocalDir( $parser, 'result' =>
$result2, );
@@ -520,8 +533,8 @@
);
}
else {
- my $global = get_global($parser);
- push @opcodes, @{ $global->[1] };
+ my $env = get_environ($parser);
+ push @opcodes, @{ $env->[1] };
my $key = BuildLiteral( $parser, $idf, 'key' );
push @opcodes, @{ $key->[1] };
$result = new_tmp( $parser, 'pmc' );
@@ -529,7 +542,7 @@
push @opcodes, new KeyedGetOp(
$parser,
'result' => $result,
- 'arg1' => $global->[0],
+ 'arg1' => $env->[0],
'arg2' => $key->[0],
);
}
@@ -1293,6 +1306,13 @@
'result' => $result,
'arg1' => $fct,
);
+ my $env = get_environ($parser);
+ push @opcodes1, @{ $env->[1] };
+ push @opcodes1, new CallMethOp(
+ $parser,
+ 'arg1' => 'setfenv',
+ 'arg2' => [ $result, $env->[0] ],
+ );
return [ $result, [EMAIL PROTECTED] ];
}
Modified: trunk/languages/lua/Lua/lua51.yp
==============================================================================
--- trunk/languages/lua/Lua/lua51.yp (original)
+++ trunk/languages/lua/Lua/lua51.yp Mon Apr 2 23:16:33 2007
@@ -674,7 +674,9 @@
sub Generate {
my $parser = shift;
- my %outer;
+ my %outer = (
+ '_main' => '__start'
+ );
foreach my $fct ( @{ $parser->YYData->{functs} } ) {
my $curr;
foreach my $op ( @{$fct} ) {
@@ -683,7 +685,7 @@
if ( exists $outer{$curr} ) {
$op->{outer} = $outer{$curr};
}
- elsif ( $curr ne '_main' ) {
+ else {
warn "INTERNAL ERROR: no outer for '$curr'\n";
}
}
Modified: trunk/languages/lua/Lua/opcode.pm
==============================================================================
--- trunk/languages/lua/Lua/opcode.pm (original)
+++ trunk/languages/lua/Lua/opcode.pm Mon Apr 2 23:16:33 2007
@@ -70,7 +70,7 @@
package NoOp;
use base qw(Lua::opcode);
-package GetGlobalOp;
+package InterpInfoOp;
use base qw(Lua::opcode);
package FindLexOp;
Modified: trunk/languages/lua/Lua/parser.pm
==============================================================================
--- trunk/languages/lua/Lua/parser.pm (original)
+++ trunk/languages/lua/Lua/parser.pm Mon Apr 2 23:16:33 2007
@@ -3813,7 +3813,9 @@
sub Generate {
my $parser = shift;
- my %outer;
+ my %outer = (
+ '_main' => '__start'
+ );
foreach my $fct ( @{ $parser->YYData->{functs} } ) {
my $curr;
foreach my $op ( @{$fct} ) {
@@ -3822,7 +3824,7 @@
if ( exists $outer{$curr} ) {
$op->{outer} = $outer{$curr};
}
- elsif ( $curr ne '_main' ) {
+ else {
warn "INTERNAL ERROR: no outer for '$curr'\n";
}
}
Modified: trunk/languages/lua/Lua/pir.pm
==============================================================================
--- trunk/languages/lua/Lua/pir.pm (original)
+++ trunk/languages/lua/Lua/pir.pm Mon Apr 2 23:16:33 2007
@@ -13,6 +13,8 @@
my ($fh) = @_;
$self->{fh} = $fh;
$self->{prologue} = q{
+.include 'interpinfo.pasm'
+
.HLL 'Lua', 'lua_group'
.sub '__start' :main
@@ -43,7 +45,12 @@
load_bytecode 'languages/lua/lib/luaos.pbc'
load_bytecode 'languages/lua/lib/luadebug.pbc'
load_bytecode 'languages/lua/lib/luaperl.pbc'
- _main($P0 :flat)
+
+ .const .Sub main = '_main'
+ .local pmc env
+ env = get_global '_G'
+ main.'setfenv'(env)
+ main($P0 :flat)
.end
.sub '__onload' :anon :init
@@ -119,11 +126,11 @@
return;
}
- sub visitGetGlobalOp {
+ sub visitInterpInfoOp {
my $self = shift;
my ($op) = @_;
my $FH = $self->{fh};
- print {$FH} " $op->{result}->{symbol} = get_global '$op->{arg1}'\n";
+ print {$FH} " $op->{result}->{symbol} = interpinfo $op->{arg1}\n";
return;
}
@@ -213,26 +220,29 @@
$first = 0;
}
print {$FH} ")\n";
+ delete $self->{getfenv};
return;
}
sub visitCallMethOp {
my $self = shift;
my ($op) = @_;
+ if ( $op->{arg1} eq 'getfenv') {
+ return if ( exists $self->{getfenv} );
+ $self->{getfenv} = 1;
+ }
my $FH = $self->{fh};
print {$FH} " ";
if ( exists $op->{result} and scalar( @{ $op->{result} } ) ) {
- print {$FH} "(";
+ print {$FH} "(" if ( scalar( @{ $op->{result} } ) > 1 );
my $first = 1;
foreach ( @{ $op->{result} } ) {
print {$FH} ", " unless ($first);
print {$FH} "$_->{symbol}";
- if ( exists $_->{pragma} and $_->{pragma} eq 'multi' ) {
- print {$FH} " :slurpy";
- }
$first = 0;
}
- print {$FH} ") = ";
+ print {$FH} ")" if ( scalar( @{ $op->{result} } ) > 1 );
+ print {$FH} " = ";
}
my @args = @{ $op->{arg2} };
my $obj = shift @args;
@@ -321,6 +331,7 @@
my ($op) = @_;
my $FH = $self->{fh};
print {$FH} "$op->{arg1}->{symbol}:\n";
+ delete $self->{getfenv};
return;
}
@@ -333,6 +344,7 @@
print {$FH} " :outer($dir->{outer})";
}
print {$FH} "\n";
+ delete $self->{getfenv};
return;
}
Modified: trunk/languages/lua/lib/alarm.pir
==============================================================================
--- trunk/languages/lua/lib/alarm.pir (original)
+++ trunk/languages/lua/lib/alarm.pir Mon Apr 2 23:16:33 2007
@@ -33,6 +33,7 @@
new $P1, .LuaString
.const .Sub _alarm = '_alarm'
+ _alarm.'setfenv'(_lua__GLOBAL)
set $P1, 'alarm'
_lua__GLOBAL[$P1] = _alarm
Modified: trunk/languages/lua/lib/luaaux.pir
==============================================================================
--- trunk/languages/lua/lib/luaaux.pir (original)
+++ trunk/languages/lua/lib/luaaux.pir Mon Apr 2 23:16:33 2007
@@ -211,6 +211,24 @@
.end
+=item C<getfenv (o)>
+
+=cut
+
+.sub 'getfenv'
+ .param pmc o
+ .local pmc ret
+ if null o goto L1
+ $I0 = can o, 'getfenv'
+ unless $I0 goto L1
+ ret = o.'getfenv'()
+ .return (ret)
+L1:
+ new ret, .LuaNil
+ .return (ret)
+.end
+
+
=item C<gsub (src, pat, repl)>
=cut
@@ -248,6 +266,9 @@
lua_comp = compreg 'Lua'
push_eh _handler
$P0 = lua_comp.'compile'(buff)
+ .local pmc env
+ env = get_global '_G'
+ $P0.'setfenv'(env)
.return ($P0)
_handler:
.get_results ($P0, $S0)
@@ -278,6 +299,9 @@
lua_comp = compreg 'Lua'
push_eh _handler
$P0 = lua_comp.'compile'($S0)
+ .local pmc env
+ env = get_global '_G'
+ $P0.'setfenv'(env)
.return ($P0)
_handler:
.get_results ($P0, $S0)
@@ -386,6 +410,23 @@
.end
+=item C<setfenv (o, table)>
+
+=cut
+
+.sub 'setfenv'
+ .param pmc o
+ .param pmc table
+ if null o goto L1
+ $I0 = can o, 'setfenv'
+ unless $I0 goto L1
+ o.'setfenv'(table)
+ .return (1)
+L1:
+ .return (0)
+.end
+
+
=item C<tag_error (got, expec)>
=cut
Modified: trunk/languages/lua/lib/luabasic.pir
==============================================================================
--- trunk/languages/lua/lib/luabasic.pir (original)
+++ trunk/languages/lua/lib/luabasic.pir Mon Apr 2 23:16:33 2007
@@ -77,102 +77,127 @@
=cut
.const .Sub _lua_assert = '_lua_assert'
+ _lua_assert.'setfenv'(_lua__GLOBAL)
set $P1, 'assert'
_lua__GLOBAL[$P1] = _lua_assert
.const .Sub _lua_collectgarbage = '_lua_collectgarbage'
+ _lua_collectgarbage.'setfenv'(_lua__GLOBAL)
set $P1, 'collectgarbage'
_lua__GLOBAL[$P1] = _lua_collectgarbage
.const .Sub _lua_dofile = '_lua_dofile'
+ _lua_dofile.'setfenv'(_lua__GLOBAL)
set $P1, 'dofile'
_lua__GLOBAL[$P1] = _lua_dofile
.const .Sub _lua_error = '_lua_error'
+ _lua_error.'setfenv'(_lua__GLOBAL)
set $P1, 'error'
_lua__GLOBAL[$P1] = _lua_error
.const .Sub _lua_getfenv = '_lua_getfenv'
+ _lua_getfenv.'setfenv'(_lua__GLOBAL)
set $P1, 'getfenv'
_lua__GLOBAL[$P1] = _lua_getfenv
.const .Sub _lua_getmetatable = '_lua_getmetatable'
+ _lua_getmetatable.'setfenv'(_lua__GLOBAL)
set $P1, 'getmetatable'
_lua__GLOBAL[$P1] = _lua_getmetatable
.const .Sub _lua_ipairs = '_lua_ipairs'
+ _lua_ipairs.'setfenv'(_lua__GLOBAL)
set $P1, 'ipairs'
_lua__GLOBAL[$P1] = _lua_ipairs
.const .Sub _lua_load = '_lua_load'
+ _lua_load.'setfenv'(_lua__GLOBAL)
set $P1, 'load'
_lua__GLOBAL[$P1] = _lua_load
.const .Sub _lua_loadfile = '_lua_loadfile'
+ _lua_loadfile.'setfenv'(_lua__GLOBAL)
set $P1, 'loadfile'
_lua__GLOBAL[$P1] = _lua_loadfile
.const .Sub _lua_loadstring = '_lua_loadstring'
+ _lua_loadstring.'setfenv'(_lua__GLOBAL)
set $P1, 'loadstring'
_lua__GLOBAL[$P1] = _lua_loadstring
.const .Sub _lua_next = '_lua_next'
+ _lua_next.'setfenv'(_lua__GLOBAL)
set $P1, 'next'
_lua__GLOBAL[$P1] = _lua_next
.const .Sub _lua_pairs = '_lua_pairs'
+ _lua_pairs.'setfenv'(_lua__GLOBAL)
set $P1, 'pairs'
_lua__GLOBAL[$P1] = _lua_pairs
.const .Sub _lua_pcall = '_lua_pcall'
+ _lua_pcall.'setfenv'(_lua__GLOBAL)
set $P1, 'pcall'
_lua__GLOBAL[$P1] = _lua_pcall
.const .Sub _lua_print = '_lua_print'
+ _lua_print.'setfenv'(_lua__GLOBAL)
set $P1, 'print'
_lua__GLOBAL[$P1] = _lua_print
.const .Sub _lua_rawequal = '_lua_rawequal'
+ _lua_rawequal.'setfenv'(_lua__GLOBAL)
set $P1, 'rawequal'
_lua__GLOBAL[$P1] = _lua_rawequal
.const .Sub _lua_rawget = '_lua_rawget'
+ _lua_rawget.'setfenv'(_lua__GLOBAL)
set $P1, 'rawget'
_lua__GLOBAL[$P1] = _lua_rawget
.const .Sub _lua_rawset = '_lua_rawset'
+ _lua_rawset.'setfenv'(_lua__GLOBAL)
set $P1, 'rawset'
_lua__GLOBAL[$P1] = _lua_rawset
.const .Sub _lua_select = '_lua_select'
+ _lua_select.'setfenv'(_lua__GLOBAL)
set $P1, 'select'
_lua__GLOBAL[$P1] = _lua_select
.const .Sub _lua_setfenv = '_lua_setfenv'
+ _lua_setfenv.'setfenv'(_lua__GLOBAL)
set $P1, 'setfenv'
_lua__GLOBAL[$P1] = _lua_setfenv
.const .Sub _lua_setmetatable = '_lua_setmetatable'
+ _lua_setmetatable.'setfenv'(_lua__GLOBAL)
set $P1, 'setmetatable'
_lua__GLOBAL[$P1] = _lua_setmetatable
.const .Sub _lua_tonumber = '_lua_tonumber'
+ _lua_tonumber.'setfenv'(_lua__GLOBAL)
set $P1, 'tonumber'
_lua__GLOBAL[$P1] = _lua_tonumber
.const .Sub _lua_tostring = '_lua_tostring'
+ _lua_tostring.'setfenv'(_lua__GLOBAL)
set $P1, 'tostring'
_lua__GLOBAL[$P1] = _lua_tostring
.const .Sub _lua_type = '_lua_type'
+ _lua_type.'setfenv'(_lua__GLOBAL)
set $P1, 'type'
_lua__GLOBAL[$P1] = _lua_type
.const .Sub _lua_unpack = '_lua_unpack'
+ _lua_unpack.'setfenv'(_lua__GLOBAL)
set $P1, 'unpack'
_lua__GLOBAL[$P1] = _lua_unpack
.const .Sub _lua_xpcall = '_lua_xpcall'
+ _lua_xpcall.'setfenv'(_lua__GLOBAL)
set $P1, 'xpcall'
_lua__GLOBAL[$P1] = _lua_xpcall
@@ -370,14 +395,47 @@
function, or if C<f> is 0, C<getfenv> returns the global environment. The
default for C<f> is 1.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_lua_getfenv' :anon
- not_implemented()
+ .param pmc f :optional
+ .local pmc ret
+ if null f goto L1
+ .const .LuaNumber zero = '0'
+ if f == zero goto L2
+L1:
+ f = getfunc(f)
+ $I0 = isa f, 'LuaClosure'
+ if $I0 goto L3
+L2:
+ ret = get_global '_G'
+ .return (ret)
+L3:
+ .return getfenv(f)
.end
+.sub 'getfunc' :anon
+ .param pmc f
+ if null f goto L1
+ $I0 = isa f, 'LuaFunction'
+ if $I0 goto L2
+ $I0 = isa f, 'LuaClosure'
+ if $I0 goto L2
+L1:
+ .local int level
+ level = optint(f, 1)
+ if level >= 0 goto L3
+ error("level must be non-negative")
+L3:
+ $P0 = getinterp
+ inc level
+ push_eh _handler
+ f = $P0['sub'; level]
+L2:
+ .return (f)
+_handler:
+ error("invalid level")
+.end
=item C<getmetatable (object)>
@@ -768,15 +826,28 @@
As a special case, when C<f> is 0 C<setfenv> changes the environment of the
running thread. In this case, C<setfenv> returns no values.
-NOT YET IMPLEMENTED.
+STILL INCOMPLETE.
=cut
.sub '_lua_setfenv' :anon
.param pmc f :optional
.param pmc table :optional
+ .const .LuaNumber zero = '0'
checktype(table, 'table')
+ unless f == zero goto L1
+ # change environment of current thread
not_implemented()
+ .return ()
+L1:
+ f = getfunc(f)
+ $I0 = isa f, 'LuaFunction'
+ if $I0 goto L2
+ $I0 = setfenv(f, table)
+ unless $I0 goto L2
+ .return (f)
+L2:
+ error("'setfenv' cannot change environment of given object")
.end
Modified: trunk/languages/lua/lib/luacoroutine.pir
==============================================================================
--- trunk/languages/lua/lib/luacoroutine.pir (original)
+++ trunk/languages/lua/lib/luacoroutine.pir Mon Apr 2 23:16:33 2007
@@ -1,4 +1,4 @@
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -39,26 +39,32 @@
_register($P1, _coroutine)
.const .Sub _coroutine_create = '_coroutine_create'
+ _coroutine_create.'setfenv'(_lua__GLOBAL)
set $P1, 'create'
_coroutine[$P1] = _coroutine_create
.const .Sub _coroutine_resume = '_coroutine_resume'
+ _coroutine_resume.'setfenv'(_lua__GLOBAL)
set $P1, 'resume'
_coroutine[$P1] = _coroutine_resume
.const .Sub _coroutine_running = '_coroutine_running'
+ _coroutine_running.'setfenv'(_lua__GLOBAL)
set $P1, 'running'
_coroutine[$P1] = _coroutine_running
.const .Sub _coroutine_status = '_coroutine_status'
+ _coroutine_status.'setfenv'(_lua__GLOBAL)
set $P1, 'status'
_coroutine[$P1] = _coroutine_status
.const .Sub _coroutine_wrap = '_coroutine_wrap'
+ _coroutine_wrap.'setfenv'(_lua__GLOBAL)
set $P1, 'wrap'
_coroutine[$P1] = _coroutine_wrap
.const .Sub _coroutine_yield = '_coroutine_yield'
+ _coroutine_yield.'setfenv'(_lua__GLOBAL)
set $P1, 'yield'
_coroutine[$P1] = _coroutine_yield
Modified: trunk/languages/lua/lib/luadebug.pir
==============================================================================
--- trunk/languages/lua/lib/luadebug.pir (original)
+++ trunk/languages/lua/lib/luadebug.pir Mon Apr 2 23:16:33 2007
@@ -1,4 +1,4 @@
-# Copyright (C) 2006, The Perl Foundation.
+# Copyright (C) 2006-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -47,58 +47,72 @@
_register($P1, _debug)
.const .Sub _debug_debug = '_debug_debug'
+ _debug_debug.'setfenv'(_lua__GLOBAL)
set $P1, 'debug'
_debug[$P1] = _debug_debug
.const .Sub _debug_getfenv = '_debug_getfenv'
+ _debug_getfenv.'setfenv'(_lua__GLOBAL)
set $P1, 'getfenv'
_debug[$P1] = _debug_getfenv
.const .Sub _debug_gethook = '_debug_gethook'
+ _debug_gethook.'setfenv'(_lua__GLOBAL)
set $P1, 'gethook'
_debug[$P1] = _debug_gethook
.const .Sub _debug_getinfo = '_debug_getinfo'
+ _debug_getinfo.'setfenv'(_lua__GLOBAL)
set $P1, 'getinfo'
_debug[$P1] = _debug_getinfo
.const .Sub _debug_getlocal = '_debug_getlocal'
+ _debug_getlocal.'setfenv'(_lua__GLOBAL)
set $P1, 'getlocal'
_debug[$P1] = _debug_getlocal
.const .Sub _debug_getmetatable = '_debug_getmetatable'
+ _debug_getmetatable.'setfenv'(_lua__GLOBAL)
set $P1, 'getmetatable'
_debug[$P1] = _debug_getmetatable
.const .Sub _debug_getregistry = '_debug_getregistry'
+ _debug_getregistry.'setfenv'(_lua__GLOBAL)
set $P1, 'getregistry'
_debug[$P1] = _debug_getregistry
.const .Sub _debug_getupvalue = '_debug_getupvalue'
+ _debug_getupvalue.'setfenv'(_lua__GLOBAL)
set $P1, 'getupvalue'
_debug[$P1] = _debug_getupvalue
.const .Sub _debug_setfenv = '_debug_setfenv'
+ _debug_setfenv.'setfenv'(_lua__GLOBAL)
set $P1, 'setfenv'
_debug[$P1] = _debug_setfenv
.const .Sub _debug_sethook = '_debug_sethook'
+ _debug_sethook.'setfenv'(_lua__GLOBAL)
set $P1, 'sethook'
_debug[$P1] = _debug_sethook
.const .Sub _debug_setlocal = '_debug_setlocal'
+ _debug_setlocal.'setfenv'(_lua__GLOBAL)
set $P1, 'setlocal'
_debug[$P1] = _debug_setlocal
.const .Sub _debug_setmetatable = '_debug_setmetatable'
+ _debug_setmetatable.'setfenv'(_lua__GLOBAL)
set $P1, 'setmetatable'
_debug[$P1] = _debug_setmetatable
.const .Sub _debug_setupvalue = '_debug_setupvalue'
+ _debug_setupvalue.'setfenv'(_lua__GLOBAL)
set $P1, 'setupvalue'
_debug[$P1] = _debug_setupvalue
.const .Sub _debug_traceback = '_debug_traceback'
+ _debug_traceback.'setfenv'(_lua__GLOBAL)
set $P1, 'traceback'
_debug[$P1] = _debug_traceback
@@ -128,12 +142,11 @@
Returns the environment of object C<o>.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_debug_getfenv' :anon
- not_implemented()
+ .param pmc o :optional
+ .return getfenv(o)
.end
@@ -249,12 +262,17 @@
Sets the environment of the given C<object> to the given C<table>.
-NOT YET IMPLEMENTED.
-
=cut
.sub '_debug_setfenv' :anon
- not_implemented()
+ .param pmc o :optional
+ .param pmc table :optional
+ checktype(table, 'table')
+ $I0 = setfenv(o, table)
+ unless $I0 goto L1
+ .return (o)
+L1:
+ error("'setfenv' cannot change environment of given object")
.end
Modified: trunk/languages/lua/lib/luaio.pir
==============================================================================
--- trunk/languages/lua/lib/luaio.pir (original)
+++ trunk/languages/lua/lib/luaio.pir Mon Apr 2 23:16:33 2007
@@ -52,50 +52,62 @@
_register($P1, _io)
.const .Sub _io_close = '_io_close'
+ _io_close.'setfenv'(_lua__GLOBAL)
set $P1, 'close'
_io[$P1] = _io_close
.const .Sub _io_flush = '_io_flush'
+ _io_flush.'setfenv'(_lua__GLOBAL)
set $P1, 'flush'
_io[$P1] = _io_flush
.const .Sub _io_input = '_io_input'
+ _io_input.'setfenv'(_lua__GLOBAL)
set $P1, 'input'
_io[$P1] = _io_input
.const .Sub _io_lines = '_io_lines'
+ _io_lines.'setfenv'(_lua__GLOBAL)
set $P1, 'lines'
_io[$P1] = _io_lines
.const .Sub _io_open = '_io_open'
+ _io_open.'setfenv'(_lua__GLOBAL)
set $P1, 'open'
_io[$P1] = _io_open
.const .Sub _io_output = '_io_output'
+ _io_output.'setfenv'(_lua__GLOBAL)
set $P1, 'output'
_io[$P1] = _io_output
.const .Sub _io_popen = '_io_popen'
+ _io_popen.'setfenv'(_lua__GLOBAL)
set $P1, 'popen'
_io[$P1] = _io_popen
.const .Sub _io_read = '_io_read'
+ _io_read.'setfenv'(_lua__GLOBAL)
set $P1, 'read'
_io[$P1] = _io_read
.const .Sub _io_tmpfile = '_io_tmpfile'
+ _io_tmpfile.'setfenv'(_lua__GLOBAL)
set $P1, 'tmpfile'
_io[$P1] = _io_tmpfile
.const .Sub _io_type = '_io_type'
+ _io_type.'setfenv'(_lua__GLOBAL)
set $P1, 'type'
_io[$P1] = _io_type
.const .Sub _io_write = '_io_write'
+ _io_write.'setfenv'(_lua__GLOBAL)
set $P1, 'write'
_io[$P1] = _io_write
.const .Sub _io_fclose = '_io_fclose'
+ _io_fclose.'setfenv'(_lua__GLOBAL)
set $P1, '__close'
_io[$P1] = _io_fclose
@@ -109,38 +121,47 @@
_file[$P1] = _file
.const .Sub _file_close = '_io_close'
+ _file_close.'setfenv'(_lua__GLOBAL)
set $P1, 'close'
_file[$P1] = _file_close
.const .Sub _file_flush = '_file_flush'
+ _file_flush.'setfenv'(_lua__GLOBAL)
set $P1, 'flush'
_file[$P1] = _file_flush
.const .Sub _file_lines = '_file_lines'
+ _file_lines.'setfenv'(_lua__GLOBAL)
set $P1, 'lines'
_file[$P1] = _file_lines
.const .Sub _file_read = '_file_read'
+ _file_read.'setfenv'(_lua__GLOBAL)
set $P1, 'read'
_file[$P1] = _file_read
.const .Sub _file_seek = '_file_seek'
+ _file_seek.'setfenv'(_lua__GLOBAL)
set $P1, 'seek'
_file[$P1] = _file_seek
.const .Sub _file_setvbuf = '_file_setvbuf'
+ _file_setvbuf.'setfenv'(_lua__GLOBAL)
set $P1, 'setvbuf'
_file[$P1] = _file_setvbuf
.const .Sub _file_write = '_file_write'
+ _file_write.'setfenv'(_lua__GLOBAL)
set $P1, 'write'
_file[$P1] = _file_write
.const .Sub _file__gc = '_file__gc'
+ _file__gc.'setfenv'(_lua__GLOBAL)
set $P1, '__gc'
_file[$P1] = _file__gc
.const .Sub _file__tostring = '_file__tostring'
+ _file__tostring.'setfenv'(_lua__GLOBAL)
set $P1, '__tostring'
_file[$P1] = _file__tostring
Modified: trunk/languages/lua/lib/luamath.pir
==============================================================================
--- trunk/languages/lua/lib/luamath.pir (original)
+++ trunk/languages/lua/lib/luamath.pir Mon Apr 2 23:16:33 2007
@@ -1,4 +1,4 @@
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -66,46 +66,57 @@
_register($P1, _math)
.const .Sub _math_abs = '_math_abs'
+ _math_abs.'setfenv'(_lua__GLOBAL)
set $P1, 'abs'
_math[$P1] = _math_abs
.const .Sub _math_acos = '_math_acos'
+ _math_acos.'setfenv'(_lua__GLOBAL)
set $P1, 'acos'
_math[$P1] = _math_acos
.const .Sub _math_asin = '_math_asin'
+ _math_asin.'setfenv'(_lua__GLOBAL)
set $P1, 'asin'
_math[$P1] = _math_asin
.const .Sub _math_atan = '_math_atan'
+ _math_atan.'setfenv'(_lua__GLOBAL)
set $P1, 'atan'
_math[$P1] = _math_atan
.const .Sub _math_atan2 = '_math_atan2'
+ _math_atan2.'setfenv'(_lua__GLOBAL)
set $P1, 'atan2'
_math[$P1] = _math_atan2
.const .Sub _math_ceil = '_math_ceil'
+ _math_ceil.'setfenv'(_lua__GLOBAL)
set $P1, 'ceil'
_math[$P1] = _math_ceil
.const .Sub _math_cos = '_math_cos'
+ _math_cos.'setfenv'(_lua__GLOBAL)
set $P1, 'cos'
_math[$P1] = _math_cos
.const .Sub _math_deg = '_math_deg'
+ _math_deg.'setfenv'(_lua__GLOBAL)
set $P1, 'deg'
_math[$P1] = _math_deg
.const .Sub _math_exp = '_math_exp'
+ _math_exp.'setfenv'(_lua__GLOBAL)
set $P1, 'exp'
_math[$P1] = _math_exp
.const .Sub _math_floor = '_math_floor'
+ _math_floor.'setfenv'(_lua__GLOBAL)
set $P1, 'floor'
_math[$P1] = _math_floor
.const .Sub _math_fmod = '_math_fmod'
+ _math_fmod.'setfenv'(_lua__GLOBAL)
set $P1, 'fmod'
_math[$P1] = _math_fmod
@@ -114,58 +125,72 @@
_math[$P1] = _math_fmod
.const .Sub _math_frexp = '_math_frexp'
+ _math_frexp.'setfenv'(_lua__GLOBAL)
set $P1, 'frexp'
_math[$P1] = _math_frexp
.const .Sub _math_ldexp = '_math_ldexp'
+ _math_ldexp.'setfenv'(_lua__GLOBAL)
set $P1, 'ldexp'
_math[$P1] = _math_ldexp
.const .Sub _math_log = '_math_log'
+ _math_log.'setfenv'(_lua__GLOBAL)
set $P1, 'log'
_math[$P1] = _math_log
.const .Sub _math_log10 = '_math_log10'
+ _math_log10.'setfenv'(_lua__GLOBAL)
set $P1, 'log10'
_math[$P1] = _math_log10
.const .Sub _math_max = '_math_max'
+ _math_max.'setfenv'(_lua__GLOBAL)
set $P1, 'max'
_math[$P1] = _math_max
.const .Sub _math_min = '_math_min'
+ _math_min.'setfenv'(_lua__GLOBAL)
set $P1, 'min'
_math[$P1] = _math_min
.const .Sub _math_modf = '_math_modf'
+ _math_modf.'setfenv'(_lua__GLOBAL)
set $P1, 'modf'
_math[$P1] = _math_modf
.const .Sub _math_pow = '_math_pow'
+ _math_pow.'setfenv'(_lua__GLOBAL)
set $P1, 'pow'
_math[$P1] = _math_pow
.const .Sub _math_rad = '_math_rad'
+ _math_rad.'setfenv'(_lua__GLOBAL)
set $P1, 'rad'
_math[$P1] = _math_rad
.const .Sub _math_random = '_math_random'
+ _math_random.'setfenv'(_lua__GLOBAL)
set $P1, 'random'
_math[$P1] = _math_random
.const .Sub _math_randomseed = '_math_randomseed'
+ _math_randomseed.'setfenv'(_lua__GLOBAL)
set $P1, 'randomseed'
_math[$P1] = _math_randomseed
.const .Sub _math_sin = '_math_sin'
+ _math_sin.'setfenv'(_lua__GLOBAL)
set $P1, 'sin'
_math[$P1] = _math_sin
.const .Sub _math_sqrt = '_math_sqrt'
+ _math_sqrt.'setfenv'(_lua__GLOBAL)
set $P1, 'sqrt'
_math[$P1] = _math_sqrt
.const .Sub _math_tan = '_math_tan'
+ _math_tan.'setfenv'(_lua__GLOBAL)
set $P1, 'tan'
_math[$P1] = _math_tan
Modified: trunk/languages/lua/lib/luaos.pir
==============================================================================
--- trunk/languages/lua/lib/luaos.pir (original)
+++ trunk/languages/lua/lib/luaos.pir Mon Apr 2 23:16:33 2007
@@ -37,46 +37,57 @@
_register($P1, _os)
.const .Sub _os_clock = '_os_clock'
+ _os_clock.'setfenv'(_lua__GLOBAL)
set $P1, 'clock'
_os[$P1] = _os_clock
.const .Sub _os_date = '_os_date'
+ _os_date.'setfenv'(_lua__GLOBAL)
set $P1, 'date'
_os[$P1] = _os_date
.const .Sub _os_difftime = '_os_difftime'
+ _os_difftime.'setfenv'(_lua__GLOBAL)
set $P1, 'difftime'
_os[$P1] = _os_difftime
.const .Sub _os_execute = '_os_execute'
+ _os_execute.'setfenv'(_lua__GLOBAL)
set $P1, 'execute'
_os[$P1] = _os_execute
.const .Sub _os_exit = '_os_exit'
+ _os_exit.'setfenv'(_lua__GLOBAL)
set $P1, 'exit'
_os[$P1] = _os_exit
.const .Sub _os_getenv = '_os_getenv'
+ _os_getenv.'setfenv'(_lua__GLOBAL)
set $P1, 'getenv'
_os[$P1] = _os_getenv
.const .Sub _os_remove = '_os_remove'
+ _os_remove.'setfenv'(_lua__GLOBAL)
set $P1, 'remove'
_os[$P1] = _os_remove
.const .Sub _os_rename = '_os_rename'
+ _os_rename.'setfenv'(_lua__GLOBAL)
set $P1, 'rename'
_os[$P1] = _os_rename
.const .Sub _os_setlocale = '_os_setlocale'
+ _os_setlocale.'setfenv'(_lua__GLOBAL)
set $P1, 'setlocale'
_os[$P1] = _os_setlocale
.const .Sub _os_time = '_os_time'
+ _os_time.'setfenv'(_lua__GLOBAL)
set $P1, 'time'
_os[$P1] = _os_time
.const .Sub _os_tmpname = '_os_tmpname'
+ _os_tmpname.'setfenv'(_lua__GLOBAL)
set $P1, 'tmpname'
_os[$P1] = _os_tmpname
Modified: trunk/languages/lua/lib/luapackage.pir
==============================================================================
--- trunk/languages/lua/lib/luapackage.pir (original)
+++ trunk/languages/lua/lib/luapackage.pir Mon Apr 2 23:16:33 2007
@@ -29,10 +29,12 @@
new $P1, .LuaString
.const .Sub _lua_module = '_lua_module'
+ _lua_module.'setfenv'(_lua__GLOBAL)
set $P1, 'module'
_lua__GLOBAL[$P1] = _lua_module
.const .Sub _lua_require = '_lua_require'
+ _lua_require.'setfenv'(_lua__GLOBAL)
set $P1, 'require'
_lua__GLOBAL[$P1] = _lua_require
@@ -44,6 +46,7 @@
_register($P1, _package)
.const .Sub _package_loadlib = '_package_loadlib'
+ _package_loadlib.'setfenv'(_lua__GLOBAL)
set $P1, 'loadlib'
_package[$P1] = _package_loadlib
@@ -51,6 +54,7 @@
_lua__GLOBAL[$P1] = _package_loadlib
.const .Sub _package_seeall = '_package_seeall'
+ _package_seeall.'setfenv'(_lua__GLOBAL)
set $P1, 'seeall'
_package[$P1] = _package_seeall
@@ -325,8 +329,6 @@
This function may receive optional I<options> after the module name, where
each option is a function to be applied over the module.
-STILL INCOMPLETE (see setfenv).
-
=cut
.sub '_lua_module' :anon
@@ -358,6 +360,7 @@
set $P1, '_NAME'
$P0 = m[$P1]
$I0 = isa $P0, 'LuaNil'
+ # is table an initialized module?
unless $I0 goto L3
# no; initialize it
m[$P1] = name
@@ -381,7 +384,9 @@
L4:
m[$P1] = name
L3:
- # setfenv(1, m)
+ $P2 = getinterp
+ $P3 = $P2['sub'; 1]
+ setfenv($P3, m)
L6:
unless options goto L7
$P0 = shift options
Modified: trunk/languages/lua/lib/luastring.pir
==============================================================================
--- trunk/languages/lua/lib/luastring.pir (original)
+++ trunk/languages/lua/lib/luastring.pir Mon Apr 2 23:16:33 2007
@@ -48,26 +48,32 @@
_register($P1, _string)
.const .Sub _string_byte = '_string_byte'
+ _string_byte.'setfenv'(_lua__GLOBAL)
set $P1, 'byte'
_string[$P1] = _string_byte
.const .Sub _string_char = '_string_char'
+ _string_char.'setfenv'(_lua__GLOBAL)
set $P1, 'char'
_string[$P1] = _string_char
.const .Sub _string_dump = '_string_dump'
+ _string_dump.'setfenv'(_lua__GLOBAL)
set $P1, 'dump'
_string[$P1] = _string_dump
.const .Sub _string_find = '_string_find'
+ _string_find.'setfenv'(_lua__GLOBAL)
set $P1, 'find'
_string[$P1] = _string_find
.const .Sub _string_format = '_string_format'
+ _string_format.'setfenv'(_lua__GLOBAL)
set $P1, 'format'
_string[$P1] = _string_format
.const .Sub _string_gmatch = '_string_gmatch'
+ _string_gmatch.'setfenv'(_lua__GLOBAL)
set $P1, 'gmatch'
_string[$P1] = _string_gmatch
@@ -76,34 +82,42 @@
_string[$P1] = _string_gmatch
.const .Sub _string_gsub = '_string_gsub'
+ _string_gsub.'setfenv'(_lua__GLOBAL)
set $P1, 'gsub'
_string[$P1] = _string_gsub
.const .Sub _string_len = '_string_len'
+ _string_len.'setfenv'(_lua__GLOBAL)
set $P1, 'len'
_string[$P1] = _string_len
.const .Sub _string_lower = '_string_lower'
+ _string_lower.'setfenv'(_lua__GLOBAL)
set $P1, 'lower'
_string[$P1] = _string_lower
.const .Sub _string_match = '_string_match'
+ _string_match.'setfenv'(_lua__GLOBAL)
set $P1, 'match'
_string[$P1] = _string_match
.const .Sub _string_rep = '_string_rep'
+ _string_rep.'setfenv'(_lua__GLOBAL)
set $P1, 'rep'
_string[$P1] = _string_rep
.const .Sub _string_reverse = '_string_reverse'
+ _string_reverse.'setfenv'(_lua__GLOBAL)
set $P1, 'reverse'
_string[$P1] = _string_reverse
.const .Sub _string_sub = '_string_sub'
+ _string_sub.'setfenv'(_lua__GLOBAL)
set $P1, 'sub'
_string[$P1] = _string_sub
.const .Sub _string_upper = '_string_upper'
+ _string_upper.'setfenv'(_lua__GLOBAL)
set $P1, 'upper'
_string[$P1] = _string_upper
@@ -631,7 +645,8 @@
.local pmc rulesub
rulesub = regex_comp($S2)
.lex 'upvar_rulesub', rulesub
- .lex 'upvar_s', s
+ $P0 = clone s
+ .lex 'upvar_s', $P0
.const .Sub gmatch_aux = 'gmatch_aux'
ret = newclosure gmatch_aux
.return (ret)
Modified: trunk/languages/lua/lib/luatable.pir
==============================================================================
--- trunk/languages/lua/lib/luatable.pir (original)
+++ trunk/languages/lua/lib/luatable.pir Mon Apr 2 23:16:33 2007
@@ -1,4 +1,4 @@
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -42,39 +42,48 @@
_register($P1, _table)
.const .Sub _table_concat = '_table_concat'
+ _table_concat.'setfenv'(_lua__GLOBAL)
set $P1, 'concat'
_table[$P1] = _table_concat
.const .Sub _table_foreach = '_table_foreach'
+ _table_foreach.'setfenv'(_lua__GLOBAL)
set $P1, 'foreach'
_table[$P1] = _table_foreach
.const .Sub _table_foreachi = '_table_foreachi'
+ _table_foreachi.'setfenv'(_lua__GLOBAL)
set $P1, 'foreachi'
_table[$P1] = _table_foreachi
# LUA_COMPAT_GETN
.const .Sub _table_getn = '_table_getn'
+ _table_getn.'setfenv'(_lua__GLOBAL)
set $P1, 'getn'
_table[$P1] = _table_getn
.const .Sub _table_insert = '_table_insert'
+ _table_insert.'setfenv'(_lua__GLOBAL)
set $P1, 'insert'
_table[$P1] = _table_insert
.const .Sub _table_maxn = '_table_maxn'
+ _table_maxn.'setfenv'(_lua__GLOBAL)
set $P1, 'maxn'
_table[$P1] = _table_maxn
.const .Sub _table_remove = '_table_remove'
+ _table_remove.'setfenv'(_lua__GLOBAL)
set $P1, 'remove'
_table[$P1] = _table_remove
.const .Sub _table_setn = '_table_setn'
+ _table_setn.'setfenv'(_lua__GLOBAL)
set $P1, 'setn'
_table[$P1] = _table_setn
.const .Sub _table_sort = '_table_sort'
+ _table_sort.'setfenv'(_lua__GLOBAL)
set $P1, 'sort'
_table[$P1] = _table_sort
Modified: trunk/languages/lua/pmc/luaclosure.pmc
==============================================================================
--- trunk/languages/lua/pmc/luaclosure.pmc (original)
+++ trunk/languages/lua/pmc/luaclosure.pmc Mon Apr 2 23:16:33 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2006, The Perl Foundation.
+Copyright (C) 2006-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -26,6 +26,7 @@
static STRING *luafunction_name;
extern INTVAL dynpmc_LuaBoolean;
+extern INTVAL dynpmc_LuaNil;
pmclass LuaClosure
@@ -34,6 +35,7 @@
does scalar
does sub
dynpmc
+ need_ext
group lua_group
hll Lua
maps Closure {
@@ -61,6 +63,30 @@
/*
+=item C<PMC *clone()>
+
+=cut
+
+*/
+ PMC* clone() {
+ struct Parrot_sub * sub;
+ PMC* const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+ /*
+ * we have to mark it ourselves
+ */
+ PObj_custom_mark_destroy_SETALL(ret);
+ sub = mem_sys_allocate(sizeof (struct Parrot_sub));
+ /* first set the sub struct, string_copy may cause GC */
+ PMC_struct_val(ret) = sub;
+ PMC_pmc_val(ret) = NULL;
+ memcpy(sub, PMC_sub(SELF), sizeof (struct Parrot_sub));
+ sub->name = string_copy(INTERP, sub->name);
+ PMC_metadata(ret) = PMC_metadata(SELF);
+ return ret;
+ }
+
+/*
+
=item C<STRING* get_string()>
=cut
@@ -95,6 +121,21 @@
=over 4
+=item C<PMC *getfenv()>
+
+=cut
+
+*/
+ METHOD PMC* getfenv() {
+ PMC *retval = PMC_metadata(SELF);
+ if (retval != NULL)
+ return retval;
+ else
+ return pmc_new(INTERP, dynpmc_LuaNil);
+ }
+
+/*
+
=item C<PMC* rawequal (PMC* value)>
=cut
@@ -113,6 +154,17 @@
return retval;
}
+/*
+
+=item C<void setfenv(PMC *env)>
+
+=cut
+
+*/
+ METHOD void setfenv(PMC *env) {
+ PMC_metadata(SELF) = env;
+ }
+
}
/*
Modified: trunk/languages/lua/pmc/luafunction.pmc
==============================================================================
--- trunk/languages/lua/pmc/luafunction.pmc (original)
+++ trunk/languages/lua/pmc/luafunction.pmc Mon Apr 2 23:16:33 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005-2006, The Perl Foundation.
+Copyright (C) 2005-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -27,6 +27,7 @@
static STRING *luafunction_name;
extern INTVAL dynpmc_LuaBoolean;
+extern INTVAL dynpmc_LuaNil;
pmclass LuaFunction
@@ -35,6 +36,7 @@
does scalar
does sub
dynpmc
+ need_ext
group lua_group
hll Lua
maps Sub {
@@ -62,6 +64,30 @@
/*
+=item C<PMC *clone()>
+
+=cut
+
+*/
+ PMC* clone() {
+ struct Parrot_sub * sub;
+ PMC* const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+ /*
+ * we have to mark it ourselves
+ */
+ PObj_custom_mark_destroy_SETALL(ret);
+ sub = mem_sys_allocate(sizeof (struct Parrot_sub));
+ /* first set the sub struct, string_copy may cause GC */
+ PMC_struct_val(ret) = sub;
+ PMC_pmc_val(ret) = NULL;
+ memcpy(sub, PMC_sub(SELF), sizeof (struct Parrot_sub));
+ sub->name = string_copy(INTERP, sub->name);
+ PMC_metadata(ret) = PMC_metadata(SELF);
+ return ret;
+ }
+
+/*
+
=item C<STRING* get_string()>
=cut
@@ -96,6 +122,21 @@
=over 4
+=item C<PMC *getfenv()>
+
+=cut
+
+*/
+ METHOD PMC* getfenv() {
+ PMC *retval = PMC_metadata(SELF);
+ if (retval != NULL)
+ return retval;
+ else
+ return pmc_new(INTERP, dynpmc_LuaNil);
+ }
+
+/*
+
=item C<PMC* rawequal (PMC* value)>
=cut
@@ -114,6 +155,17 @@
return retval;
}
+/*
+
+=item C<void setfenv(PMC *env)>
+
+=cut
+
+*/
+ METHOD void setfenv(PMC *env) {
+ PMC_metadata(SELF) = env;
+ }
+
}
/*
Modified: trunk/languages/lua/pmc/luatable.pmc
==============================================================================
--- trunk/languages/lua/pmc/luatable.pmc (original)
+++ trunk/languages/lua/pmc/luatable.pmc Mon Apr 2 23:16:33 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005-2006, The Perl Foundation.
+Copyright (C) 2005-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -70,8 +70,7 @@
STRING* keystr = _make_key(interp, key);
PMC* pair = parrot_hash_get(interp, hash, keystr);
if (pair != NULL) {
- PMC* value = PMC_pmc_val(pair);
- return VTABLE_clone(interp, value);
+ return PMC_pmc_val(pair);
}
else {
return NULL;
@@ -483,9 +482,9 @@
PMC *retval, *key, *value;
retval = pmc_new(INTERP, enum_class_Array);
VTABLE_set_integer_native(INTERP, retval, 2);
- key = VTABLE_clone(INTERP, (PMC*)(PMC_struct_val(pair)));
+ key = (PMC*)(PMC_struct_val(pair));
VTABLE_set_pmc_keyed_int(INTERP, retval, 0, key);
- value = VTABLE_clone(INTERP, PMC_pmc_val(pair));
+ value = PMC_pmc_val(pair);
VTABLE_set_pmc_keyed_int(INTERP, retval, 1, value);
return retval;
}
Modified: trunk/languages/lua/t/basic.t
==============================================================================
--- trunk/languages/lua/t/basic.t (original)
+++ trunk/languages/lua/t/basic.t Mon Apr 2 23:16:33 2007
@@ -25,7 +25,7 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 43;
+use Parrot::Test tests => 54;
use Test::More;
language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function assert' );
@@ -125,6 +125,35 @@
/\?/
OUTPUT
+language_output_is( 'lua', <<'CODE', <<'OUT', 'function getfenv' );
+local function f () end
+
+print(type(getfenv(0)))
+assert(getfenv(0) == _G)
+assert(getfenv(1) == _G)
+assert(getfenv() == _G)
+print(type(getfenv(f)))
+assert(getfenv(f) == _G)
+print(type(getfenv(print)))
+assert(getfenv(print) == _G)
+CODE
+table
+table
+table
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function getfenv (negative)'
);
+print(getfenv(-3))
+CODE
+/level must be non-negative/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function getfenv (too depth)'
);
+print(getfenv(12))
+CODE
+/invalid level/
+OUT
+
language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function ipairs' );
a = {"a","b","c"}
local f, v, s = ipairs(a)
@@ -388,6 +417,92 @@
/index out of range/
OUTPUT
+language_output_is( 'lua', <<'CODE', <<'OUT', 'function setfenv' );
+t = {}
+function f () end
+
+assert(setfenv(f, t) == f)
+print(type(getfenv(f)))
+assert(getfenv(f) == t)
+CODE
+table
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'function setfenv' );
+a = 1
+setfenv(1, {g = _G})
+g.print(a)
+g.print(g.a)
+CODE
+nil
+1
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'function setfenv' );
+a = 1
+local newgt = {} -- create new environment
+setmetatable(newgt, {__index = _G})
+setfenv(1, newgt) -- set it
+print(a)
+a = 10
+print(a)
+print(_G.a)
+_G.a = 20
+print(_G.a)
+CODE
+1
+10
+1
+20
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'function setfenv' );
+function factory ()
+ return function ()
+ return a -- "global" a
+ end
+end
+
+a = 3
+f1 = factory()
+f2 = factory()
+print(f1())
+print(f2())
+setfenv(f1, {a = 10})
+print(f1())
+print(f2())
+CODE
+3
+3
+10
+3
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function setfenv (negative)'
);
+setfenv(-3, {})
+CODE
+/level must be non-negative/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function setfenv (too depth)'
);
+print(setfenv(12, {}))
+CODE
+/invalid level/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function setfenv (bad arg)' );
+t = {}
+setfenv(t, t)
+CODE
+/number expected, got table/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'function setfenv (forbidden)'
);
+setfenv(print, {})
+CODE
+/'setfenv' cannot change environment of given object/
+OUT
+
language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function type' );
print(type("Hello world"))
print(type(10.4*3))
Modified: trunk/languages/lua/t/debug.t
==============================================================================
--- trunk/languages/lua/t/debug.t (original)
+++ trunk/languages/lua/t/debug.t Mon Apr 2 23:16:33 2007
@@ -1,5 +1,5 @@
#! perl
-# Copyright (C) 2006, The Perl Foundation.
+# Copyright (C) 2006-2007, The Perl Foundation.
# $Id$
=head1 NAME
@@ -27,10 +27,24 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 5;
use Test::More;
-language_output_is( 'lua', <<'CODE', <<'OUT', 'getmetatable' );
+language_output_is( 'lua', <<'CODE', <<'OUT', 'debug.getfenv' );
+local function f () end
+
+print(debug.getfenv(3.14))
+print(type(debug.getfenv(f)))
+assert(debug.getfenv(f) == _G)
+print(type(debug.getfenv(print)))
+assert(debug.getfenv(print) == _G)
+CODE
+nil
+table
+table
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'debug.getmetatable' );
t = {}
print(debug.getmetatable(t))
t1 = {}
@@ -40,7 +54,29 @@
nil
OUT
-language_output_is( 'lua', <<'CODE', <<'OUT', 'setmetatable' );
+language_output_is( 'lua', <<'CODE', <<'OUT', 'debug.setfenv' );
+t = {}
+function f () end
+
+assert(debug.setfenv(f, t) == f)
+print(type(debug.getfenv(f)))
+assert(debug.getfenv(f) == t)
+assert(debug.setfenv(print, t) == print)
+print(type(debug.getfenv(print)))
+assert(debug.getfenv(print) == t)
+CODE
+table
+table
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'debug.setfenv (forbidden)' );
+t = {}
+debug.setfenv(t, t)
+CODE
+/'setfenv' cannot change environment of given object/
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'debug.setmetatable' );
t = {}
t1 = {}
assert(debug.setmetatable(t, t1) == true)
