Author: fperrad
Date: Thu Mar 23 01:40:07 2006
New Revision: 11995
Added:
trunk/languages/lua/t/functions.t
Modified:
trunk/languages/lua/Lua/build.pm
trunk/languages/lua/pmc/luafunction.pmc
trunk/languages/lua/t/basic.t
Log:
Lua :
- small fix for function call generation
- complete PMC function (this PMC is now used for function in libraries)
- and tests
Modified: trunk/languages/lua/Lua/build.pm
==============================================================================
--- trunk/languages/lua/Lua/build.pm (original)
+++ trunk/languages/lua/Lua/build.pm Thu Mar 23 01:40:07 2006
@@ -531,7 +531,11 @@
my @params = ();
my @returns = ();
for my $arg (@{$args}) {
- push @opcodes, @{$arg->[1]};
+ if (scalar @{$arg->[1]}) {
+ push @opcodes, @{$arg->[1]};
+ } else {
+ push @opcodes, new NoOp($parser);
+ }
push @params, $arg->[0];
}
if (scalar(@opcodes) and $opcodes[-1]->isa("CallOp")) {
@@ -1112,7 +1116,11 @@
my @opcodes = ();
my @returns = ();
for my $expr (@{$exprs}) {
- push @opcodes, @{$expr->[1]};
+ if (scalar @{$expr->[1]}) {
+ push @opcodes, @{$expr->[1]};
+ } else {
+ push @opcodes, new NoOp($parser);
+ }
push @returns, $expr->[0];
}
if (scalar(@opcodes) and $opcodes[-1]->isa("CallOp")) {
Modified: trunk/languages/lua/pmc/luafunction.pmc
==============================================================================
--- trunk/languages/lua/pmc/luafunction.pmc (original)
+++ trunk/languages/lua/pmc/luafunction.pmc Thu Mar 23 01:40:07 2006
@@ -51,6 +51,20 @@
/* namespace hack */
meth = Parrot_find_global(INTERP,
const_string(INTERP, "LuaFunction"),
+ const_string(INTERP, "get_metatable"));
+ Parrot_store_global(INTERP,
+ const_string(INTERP, "function"),
+ const_string(INTERP, "get_metatable"),
+ meth);
+ meth = Parrot_find_global(INTERP,
+ const_string(INTERP, "LuaFunction"),
+ const_string(INTERP, "len"));
+ Parrot_store_global(INTERP,
+ const_string(INTERP, "function"),
+ const_string(INTERP, "len"),
+ meth);
+ meth = Parrot_find_global(INTERP,
+ const_string(INTERP, "LuaFunction"),
const_string(INTERP, "rawequal"));
Parrot_store_global(INTERP,
const_string(INTERP, "function"),
@@ -115,18 +129,84 @@
/*
-=item C<PMC logical_not(PMC *dest)>
+=item C<PMC* get_pmc_keyed (PMC* key)>
+
+Throws an exception.
+
+=cut
+
+*/
+ PMC* get_pmc_keyed (PMC* key) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to index a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+/*
-Return always false.
+=item C<void set_bool(INTVAL value)>
+
+=cut
+
+*/
+ void set_bool (INTVAL value) {
+ VTABLE_morph(INTERP, SELF, dynpmc_LuaBoolean);
+ VTABLE_set_bool(INTERP, SELF, value);
+ }
+
+/*
+
+=item C<void set_pmc_keyed (PMC* key, PMC* value)>
+
+Throws an exception.
+
+=cut
+
+*/
+ void set_pmc_keyed (PMC* key, PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to index a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+/*
+
+=item C<PMC* neg (PMC *dest)>
+
+=item C<void i_neg()>
+
+Throws an exception.
+
+=cut
+
+*/
+ PMC* neg (PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_neg() {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+/*
+
+=item C<PMC* logical_not(PMC *dest)>
+
+Common implementation (use C<get_bool> & C<set_bool>)
=cut
*/
PMC* logical_not (PMC* dest) {
if (!dest)
- dest = pmc_new(INTERP, pmc_type(INTERP,
- string_from_const_cstring(INTERP, "LuaBoolean", 0)));
- VTABLE_set_integer_native(INTERP, dest, 0);
+ dest = pmc_new(INTERP, SELF->vtable->base_type);
+ VTABLE_set_bool(INTERP, dest, ! DYNSELF.get_bool());
return dest;
}
@@ -134,10 +214,205 @@
=back
+=head2 non-Vtable Methods
+
+=over 4
+
+=item C<void add(PMC *value, PMC *dest)>
+
+=item C<void i_add (PMC *value)>
+
+=item C<void subtract(PMC *value, PMC *dest)>
+
+=item C<void i_substract (PMC *value)>
+
+=item C<void multiply(PMC *value, PMC *dest)>
+
+=item C<void i_multiply (PMC *value)>
+
+=item C<void divide(PMC *value, PMC *dest)>
+
+=item C<void i_divide (PMC *value)>
+
+=item C<PMC* modulus (PMC* value, PMC* dest)>
+
+=item C<void i_modulus (PMC *value)>
+
+=item C<PMC* pow (PMC* value, PMC* dest)>
+
+=item C<void i_pow (PMC *value)>
+
+=item C<PMC* concatenate (PMC *value, PMC *dest)>
+
+=item C<void i_concatenate (PMC *value)>
+
+Throws an exception.
+
+=cut
+
+*/
+ PMC* add (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_add (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* subtract (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_subtract (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* multiply (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_multiply (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* divide (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_divide (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* modulus (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_modulus (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* pow (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_pow (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to perform arithmetic on a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+ PMC* concatenate (PMC* value, PMC* dest) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to concatenate a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ return NULL;
+ }
+
+ void i_concatenate (PMC* value) {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to concatenate a %s value",
+ string_to_cstring(INTERP, DYNSELF.name()));
+ }
+
+/*
+
+=item C<INTVAL is_equal (PMC* value)>
+
+=cut
+
+*/
+ INTVAL is_equal (PMC* value) {
+MMD_LuaFunction: {
+ return (PMC_sub(SELF))->start_offs == (PMC_sub(value))->start_offs
+ && (PMC_sub(SELF))->seg == (PMC_sub(value))->seg;
+ }
+MMD_DEFAULT: {
+ return (INTVAL)0;
+ }
+ }
+
+/*
+
+=item C<INTVAL cmp (PMC* value)>
+
+=cut
+
+*/
+ INTVAL cmp (PMC* value) {
+MMD_LuaFunction: {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to compare two function values");
+ return (INTVAL)0;
+ }
+MMD_DEFAULT: {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to compare function with %s",
+ string_to_cstring(INTERP, VTABLE_name(INTERP, value)));
+ return (INTVAL)0;
+ }
+ }
+
+/*
+
+=back
+
=head2 Specific Methods
=over 4
+=item C<PMC *get_metatable()>
+
+=cut
+
+*/
+ METHOD PMC* get_metatable() {
+ return pmc_new(INTERP, dynpmc_LuaNil);
+ }
+
+/*
+
+=item C<PMC* len()>
+
+=cut
+
+*/
+ METHOD PMC* len () {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to get length of a %s value",
+ string_to_cstring(INTERP, VTABLE_name(INTERP, SELF)));
+ return NULL;
+ }
+
+/*
+
=item C<PMC* rawequal (PMC* value)>
=cut
@@ -147,8 +422,9 @@
PMC *retval;
retval = pmc_new(INTERP, dynpmc_LuaBoolean);
- if (SELF->vtable->base_type == value->vtable->base_type
- && SELF == value)
+ if ( SELF->vtable->base_type == value->vtable->base_type
+ && (PMC_sub(SELF))->start_offs == (PMC_sub(value))->start_offs
+ && (PMC_sub(SELF))->seg == (PMC_sub(value))->seg )
PMC_int_val(retval) = 1;
else
PMC_int_val(retval) = 0;
Modified: trunk/languages/lua/t/basic.t
==============================================================================
--- trunk/languages/lua/t/basic.t (original)
+++ trunk/languages/lua/t/basic.t Thu Mar 23 01:40:07 2006
@@ -53,10 +53,7 @@
language_output_is( 'lua', << 'CODE', << 'OUTPUT', "function ipairs");
a = {"a","b","c"}
local f, v, s = ipairs(a)
-if type(f) == type(type) then print "ok" end
-if a == v then print "ok" end
-print(s)
--- print(type(f), type(v), s)
+print(type(f), type(v), s)
s, v = f(a, s)
print(s, v)
s, v = f(a, s)
@@ -66,9 +63,7 @@
s, v = f(a, s)
print(s, v)
CODE
-ok
-ok
-0
+function table 0
1 a
2 b
3 c
@@ -95,10 +90,7 @@
language_output_is( 'lua', << 'CODE', << 'OUTPUT', "function pairs");
a = {"a","b","c"}
local f, v, s = pairs(a)
-if type(f) == type(type) then print "ok" end
-if a == v then print "ok" end
-print(s)
--- print(type(f), type(v), s)
+print(type(f), type(v), s)
s = f(v, s)
print(s)
s = f(v, s)
@@ -108,9 +100,7 @@
s = f(v, s)
print(s)
CODE
-ok
-ok
-nil
+function table nil
1
2
3
@@ -145,13 +135,14 @@
print(rawequal(3, 3))
print(rawequal("text", "text"))
print(rawequal(t, a))
--- print(rawequal(print, print))
+print(rawequal(print, print))
CODE
true
true
true
true
true
+true
OUTPUT
language_output_is( 'lua', << 'CODE', << 'OUTPUT', "function rawequal
(false)");
@@ -165,8 +156,8 @@
print(rawequal("text", 2))
print(rawequal(t, {}))
print(rawequal(t, 2))
--- print(rawequal(print, format))
--- print(rawequal(print, 2))
+print(rawequal(print, format))
+print(rawequal(print, 2))
CODE
false
false
@@ -177,6 +168,8 @@
false
false
false
+false
+false
OUTPUT
language_output_is( 'lua', << 'CODE', << 'OUTPUT', "function rawget");
@@ -217,8 +210,8 @@
language_output_is( 'lua', << 'CODE', << 'OUTPUT', "function type");
print(type("Hello world"))
print(type(10.4*3))
--- print(type(print))
--- print(type(type))
+print(type(print))
+print(type(type))
print(type(true))
print(type(nil))
print(type(io.stdin))
@@ -226,6 +219,8 @@
CODE
string
number
+function
+function
boolean
nil
userdata
@@ -239,11 +234,13 @@
a = "a string!!"
print(type(a))
a = print
--- a(type(a))
+a(type(a))
+--print(type(function () end))
CODE
nil
number
string
+function
OUTPUT
language_output_like( 'lua', << 'CODE', << 'OUTPUT', "function type (no arg)");
Added: trunk/languages/lua/t/functions.t
==============================================================================
--- (empty file)
+++ trunk/languages/lua/t/functions.t Thu Mar 23 01:40:07 2006
@@ -0,0 +1,196 @@
+#! perl -w
+# Copyright: 2006 The Perl Foundation. All Rights Reserved.
+# $Id: functions.t 11446 2006-02-06 14:07:49Z fperrad $
+
+=head1 NAME
+
+t/functions.t - Lua function & coercion
+
+=head1 SYNOPSIS
+
+ % perl -I../lib -Ilua/t lua/t/functions.t
+
+=head1 DESCRIPTION
+
+=cut
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin";
+
+use Parrot::Test tests => 24;
+use Test::More;
+
+language_output_like( 'lua', <<'CODE', <<'OUT', '- f' );
+f = print
+print(- print)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', '# f' );
+f = print
+print(# f)
+CODE
+/attempt to get length of/
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'not f' );
+f = print
+print(not f)
+CODE
+false
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f + 10' );
+f = print
+print(f + 10)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f - 2' );
+f = print
+print(f - 2)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f * 3.14' );
+f = print
+print(f * 3.14)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f / -7' );
+f = print
+print(f / -7)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f % 4' );
+f = print
+print(f % 4)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f ^ 3' );
+f = print
+print(f ^ 3)
+CODE
+/attempt to perform arithmetic on/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f .. "end"' );
+f = print
+print(f .. "end")
+CODE
+/attempt to concatenate/
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'f == f' );
+f = print
+print(f == print)
+CODE
+true
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'f ~= g' );
+f = print
+g = type
+print(f ~= g)
+CODE
+true
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'f == 1' );
+f = print
+print(f == 1)
+CODE
+false
+OUT
+
+language_output_is( 'lua', <<'CODE', <<'OUT', 'f ~= 1' );
+f = print
+print(f ~= 1)
+CODE
+true
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f < g' );
+f = print
+g = type
+print(f < g)
+CODE
+/attempt to compare two function values/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f <= g' );
+f = print
+g = type
+print(f <= g)
+CODE
+/attempt to compare two function values/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f > g' );
+f = print
+g = type
+print(f > g)
+CODE
+/attempt to compare two function values/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f >= g' );
+f = print
+g = type
+print(f >= g)
+CODE
+/attempt to compare two function values/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f < 0' );
+f = print
+print(f < 0)
+CODE
+/attempt to compare \w+ with \w+/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f <= 0' );
+f = print
+print(f <= 0)
+CODE
+/attempt to compare \w+ with \w+/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f > 0' );
+f = print
+print(f > 0)
+CODE
+/attempt to compare \w+ with \w+/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'f >= 0' );
+f = print
+print(f >= 0)
+CODE
+/attempt to compare \w+ with \w+/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'get_pmc_keyed' );
+a = print
+print(a[1])
+CODE
+/attempt to index/
+OUT
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'set_pmc_keyed' );
+a = print
+a[1] = 1
+CODE
+/attempt to index/
+OUT
+
