Author: fperrad
Date: Sun Jan 15 23:18:26 2006
New Revision: 11207
Modified:
trunk/languages/lua/Lua/build.pm
trunk/languages/lua/Lua/lua50.yp
trunk/languages/lua/Lua/parser.pm
trunk/languages/lua/Lua/pir.pm
trunk/languages/lua/classes/luanil.pmc
trunk/languages/lua/classes/luanumber.pmc
trunk/languages/lua/classes/luastring.pmc
trunk/languages/lua/classes/luatable.pmc
trunk/languages/lua/lib/luapir.pir
trunk/languages/lua/t/expr.t
trunk/languages/lua/t/lib/os.t
trunk/languages/lua/t/pmc/boolean.t
trunk/languages/lua/t/pmc/nil.t
trunk/languages/lua/t/pmc/number.t
trunk/languages/lua/t/pmc/string.t
Log:
Lua :
- PMC LuaNil : add get_bool(), set_integer_native()
- PMC LuaNumber : add set_integer_native(), is_equal(), cmp()
- PMC LuaString : add new_from_string(), is_equal(), cmp()
- PMC LuaTable : add is_equal(), use new implementation of LuaNil
and side effect
Modified: trunk/languages/lua/Lua/build.pm
==============================================================================
--- trunk/languages/lua/Lua/build.pm (original)
+++ trunk/languages/lua/Lua/build.pm Sun Jan 15 23:18:26 2006
@@ -66,41 +66,47 @@ sub BuildLiteral {
my ($parser, $value, $type) = @_;
my $name = "cst_" . $parser->YYData->{idx_cst}++;
- my $defn = $parser->YYData->{symbtab_cst}->Lookup($value);
+ my $defn = $parser->YYData->{symbtab_cst}->Lookup($type . $value);
if ($defn) {
return [$defn, []];
} else {
my @opcodes = ();
$defn = new defn($name, "const", "pmc", $type);
- push @opcodes, new LocalDir($parser,
+ $parser->YYData->{symbtab_cst}->Insert($type . $value, $defn);
+ if ($type eq 'key') {
+ push @opcodes, new ConstDir($parser,
'result' =>
$defn,
- );
- $parser->YYData->{symbtab_cst}->Insert($value, $defn);
- if ($type eq 'string') {
- my $str = "";
- for (split//, $value) {
- if (ord $_ < 32) {
- $str .= sprintf("\\x%02x", ord $_);
- } elsif (ord $_ >= 128) {
- $str .= sprintf("\\u%04x", ord $_);
- } elsif ($_ eq '"') {
- $str .= '\"';
- } else {
- $str .= $_;
- }
- }
- $value = "\"$str\"";
- } elsif ($type eq 'number') {
- $value = $value->bsstr();
- } elsif ($type eq 'boolean') {
- $value = ($value eq "true") ? 1 : 0;
- }
- unless ($type eq "nil") {
- my $expr = new defn($value, "literal", "pmc", $type);
- push @opcodes, new AssignOp($parser,
- 'arg1'
=> $expr,
+ 'arg1' =>
$value,
+ 'type' =>
"LuaString",
+ );
+ } else {
+ push @opcodes, new LocalDir($parser,
'result'
=> $defn,
);
+ if ($type eq 'string') {
+ my $str = "";
+ for (split//, $value) {
+ if (ord $_ < 32) {
+ $str .= sprintf("\\x%02x", ord
$_);
+ } elsif (ord $_ >= 128) {
+ $str .= sprintf("\\u%04x", ord
$_);
+ } elsif ($_ eq '"') {
+ $str .= '\"';
+ } else {
+ $str .= $_;
+ }
+ }
+ $value = "\"$str\"";
+ } elsif ($type eq 'boolean') {
+ $value = ($value eq "true") ? 1 : 0;
+ }
+ unless ($type eq "nil") {
+ my $expr = new defn($value, "literal", "pmc",
$type);
+ push @opcodes, new AssignOp($parser,
+ 'arg1'
=> $expr,
+ 'result'
=> $defn,
+ );
+ }
}
return [$defn, [EMAIL PROTECTED];
}
@@ -152,7 +158,7 @@ sub BuildVariable {
} else {
my $global = get_global($parser);
push @opcodes, @{$global->[1]};
- my $key = BuildLiteral($parser, $idf, "string");
+ my $key = BuildLiteral($parser, $idf, "key");
push @opcodes, @{$key->[1]};
my $result = $global->[0];
foreach my $key2 (@{$var}) {
@@ -218,7 +224,7 @@ sub BuildCallVariable {
} else {
my $global = get_global($parser);
push @opcodes, @{$global->[1]};
- my $key = BuildLiteral($parser, $idf, "string");
+ my $key = BuildLiteral($parser, $idf, "key");
push @opcodes, @{$key->[1]};
$result = new_tmp($parser, "pmc");
push @opcodes, new LocalDir($parser,
@@ -542,7 +548,7 @@ sub BuildForNum {
push @opcodes, @{$e_step->[1]};
my $global = get_global($parser);
push @opcodes, @{$global->[1]};
- my $key_tonumber = BuildLiteral($parser, "tonumber", "string");
+ my $key_tonumber = BuildLiteral($parser, "tonumber", "key");
push @opcodes, @{$key_tonumber->[1]};
my $fct_tonumber = new_tmp($parser, "pmc");
push @opcodes, new LocalDir($parser,
@@ -598,7 +604,7 @@ sub BuildForNum {
push @opcodes, new LabelOp($parser,
'arg1' =>
$lbl_err,
);
- my $key_error = BuildLiteral($parser, "error", "string");
+ my $key_error = BuildLiteral($parser, "error", "key");
push @opcodes, @{$key_error->[1]};
my $fct_error = new_tmp($parser, "pmc");
push @opcodes, new LocalDir($parser,
@@ -739,7 +745,7 @@ sub BuildFunctionBody {
);
push @opcodes1, new ConstDir($parser,
'result' => $fct,
- 'arg1' =>
"\"$fct->{symbol}\"",
+ 'arg1' =>
$fct->{symbol},
'type' => "Sub",
);
push @opcodes1, new AssignOp($parser,
Modified: trunk/languages/lua/Lua/lua50.yp
==============================================================================
--- trunk/languages/lua/Lua/lua50.yp (original)
+++ trunk/languages/lua/Lua/lua50.yp Sun Jan 15 23:18:26 2006
@@ -219,7 +219,7 @@ key
}
| '.' NAME
{
- BuildLiteral($_[0], $_[2], 'string');
+ BuildLiteral($_[0], $_[2], 'key');
}
;
@@ -486,7 +486,7 @@ field
}
| NAME '=' exp
{
- [BuildLiteral($_[0], $_[1], 'string'), $_[3]]
+ [BuildLiteral($_[0], $_[1], 'key'), $_[3]]
}
| exp
{
Modified: trunk/languages/lua/Lua/parser.pm
==============================================================================
--- trunk/languages/lua/Lua/parser.pm (original)
+++ trunk/languages/lua/Lua/parser.pm Sun Jan 15 23:18:26 2006
@@ -2882,7 +2882,7 @@ sub
sub
#line 221 "Lua\lua50.yp"
{
- BuildLiteral($_[0], $_[2], 'string');
+ BuildLiteral($_[0], $_[2], 'key');
}
],
[#Rule 40
@@ -3308,7 +3308,7 @@ sub
sub
#line 488 "Lua\lua50.yp"
{
- [BuildLiteral($_[0], $_[1], 'string'), $_[3]]
+ [BuildLiteral($_[0], $_[1], 'key'), $_[3]]
}
],
[#Rule 97
Modified: trunk/languages/lua/Lua/pir.pm
==============================================================================
--- trunk/languages/lua/Lua/pir.pm (original)
+++ trunk/languages/lua/Lua/pir.pm Sun Jan 15 23:18:26 2006
@@ -223,7 +223,7 @@ sub visitConstDir {
my $self = shift;
my ($dir) = @_;
my $FH = $self->{fh};
- print $FH " .const .$dir->{type} $dir->{result}->{symbol} =
$dir->{arg1}\n";
+ print $FH " .const .$dir->{type} $dir->{result}->{symbol} =
\"$dir->{arg1}\"\n";
}
1;
Modified: trunk/languages/lua/classes/luanil.pmc
==============================================================================
--- trunk/languages/lua/classes/luanil.pmc (original)
+++ trunk/languages/lua/classes/luanil.pmc Sun Jan 15 23:18:26 2006
@@ -1,5 +1,5 @@
/*
-Copyright: 2005 The Perl Foundation. All Rights Reserved.
+Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
$Id$
=head1 NAME
@@ -99,6 +99,19 @@ Return the string "nil".
/*
+=item C<INTVAL get_bool()>
+
+Return always false.
+
+=cut
+
+*/
+ INTVAL get_bool () {
+ return 0;
+ }
+
+/*
+
=item C<PMC logical_not(PMC *dest)>
Return always true.
@@ -132,6 +145,8 @@ Return always true.
=item C<void set_string_native(STRING *)>
+=item C<void set_integer_native(INTVAL)>
+
=item C<void set_bool(INTVAL)>
Methods to set a new value to this LuaNil PMC. First,
@@ -154,6 +169,11 @@ Morph to another Lua type.
VTABLE_set_string_native(INTERP, SELF, value);
}
+ void set_integer_native(INTVAL value) {
+ VTABLE_morph(INTERP, SELF, dynclass_LuaBoolean);
+ VTABLE_set_bool(INTERP, SELF, value);
+ }
+
void set_bool (INTVAL value) {
VTABLE_morph(INTERP, SELF, dynclass_LuaBoolean);
VTABLE_set_bool(INTERP, SELF, value);
@@ -165,3 +185,14 @@ Morph to another Lua type.
}
+/*
+
+=back
+
+=head1 AUTHORS
+
+Original code by Klaas-Jan Stol.
+
+=cut
+
+*/
Modified: trunk/languages/lua/classes/luanumber.pmc
==============================================================================
--- trunk/languages/lua/classes/luanumber.pmc (original)
+++ trunk/languages/lua/classes/luanumber.pmc Sun Jan 15 23:18:26 2006
@@ -69,6 +69,17 @@ So return always true.
/*
+=item C<void set_integer_native(INTVAL value)>
+
+=cut
+
+*/
+ void set_integer_native (INTVAL value) {
+ PMC_num_val(SELF) = (FLOATVAL)value;
+ }
+
+/*
+
=item C<PMC* new_from_string(STRING *rep, INTVAL flags)>
Return a LuaNumber PMC created from a string (Implementation
@@ -95,6 +106,43 @@ Allow :
return res;
}
+/*
+
+=item C<INTVAL is_equal(PMC* value)>
+
+=cut
+
+*/
+ INTVAL is_equal (PMC* value) {
+MMD_Float: {
+ return (INTVAL)(PMC_num_val(SELF) == PMC_num_val(value));
+ }
+MMD_DEFAULT: {
+ return (INTVAL)0;
+ }
+ }
+
+/*
+
+=item C<INTVAL cmp(PMC* value)>
+
+=cut
+
+*/
+ INTVAL cmp(PMC* value) {
+MMD_Float: {
+ FLOATVAL diff;
+ diff = PMC_num_val(SELF) - PMC_num_val(value);
+ return diff > 0 ? 1 : diff < 0 ? -1 : 0;
+ }
+MMD_DEFAULT: {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to compare number with %s",
+ string_to_cstring(INTERP, VTABLE_name(INTERP, value)));
+ return (INTVAL)0;
+ }
+ }
+
}
/*
Modified: trunk/languages/lua/classes/luastring.pmc
==============================================================================
--- trunk/languages/lua/classes/luastring.pmc (original)
+++ trunk/languages/lua/classes/luastring.pmc Sun Jan 15 23:18:26 2006
@@ -67,6 +67,79 @@ So return always true.
return 1;
}
+/*
+
+=item C<PMC* new_from_string(STRING *rep, INTVAL flags)>
+
+Allow :
+
+ .const .LuaString s = "Hello World!"
+
+=cut
+
+*/
+ PMC* new_from_string (STRING *rep, INTVAL flags) {
+ INTVAL type;
+ PMC *res;
+
+ type = SELF->vtable->base_type;
+ if (flags & PObj_constant_FLAG)
+ res = constant_pmc_new(INTERP, type);
+ else
+ res = pmc_new(INTERP, type);
+
+ PMC_str_val(res) = string_copy(INTERP, rep);
+ return res;
+ }
+
+/*
+
+=item C<INTVAL is_equal(PMC* value)>
+
+Compares the string with C<value>; returns true if
+they match.
+
+=cut
+
+*/
+ INTVAL is_equal (PMC* value) {
+MMD_String: {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return (INTVAL)(0 == string_equal(INTERP, s, v));
+ }
+MMD_DEFAULT: {
+ return (INTVAL)0;
+ }
+ }
+
+/*
+
+=item C<INTVAL cmp(PMC* value)>
+
+Compares the string with C<value>; returns -1 if the
+string is smaller, 0 if they are equal, and 1 if C<value>
+is smaller.
+
+Throws an exception unless C<value> is a LuaString.
+
+=cut
+
+*/
+ INTVAL cmp (PMC* value) {
+MMD_String: {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return string_compare(INTERP, s, v);
+ }
+MMD_DEFAULT: {
+ real_exception(INTERP, NULL, ILL_INHERIT,
+ "attempt to compare string with %s",
+ string_to_cstring(INTERP, VTABLE_name(INTERP, value)));
+ return (INTVAL)0;
+ }
+ }
+
}
/*
Modified: trunk/languages/lua/classes/luatable.pmc
==============================================================================
--- trunk/languages/lua/classes/luatable.pmc (original)
+++ trunk/languages/lua/classes/luatable.pmc Sun Jan 15 23:18:26 2006
@@ -1,5 +1,5 @@
/*
-Copyright: 2005 The Perl Foundation. All Rights Reserved.
+Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
$Id$
=head1 NAME
@@ -25,7 +25,7 @@ Now, Lua 5.0 uses a hybrid data structur
#include "parrot/parrot.h"
static STRING *luatable_name;
-static PMC *Lua_Nil;
+static INTVAL dynclass_LuaNil;
pmclass LuaTable
extends Hash
@@ -39,8 +39,8 @@ pmclass LuaTable
void class_init() {
if (pass) {
luatable_name = const_string(INTERP, "table");
- Lua_Nil = pmc_new(INTERP, pmc_type(INTERP,
- string_from_const_cstring(INTERP, "LuaNil", 0)));
+ dynclass_LuaNil = pmc_type(INTERP,
+ string_from_const_cstring(INTERP, "LuaNil", 0));
}
}
@@ -125,7 +125,8 @@ A copy of the value is retrieved, otherw
PMC *retval = SUPER(key);
if (enum_class_None == retval->vtable->base_type) {
- return Lua_Nil; /* should we create a New LuaNil object every
time? Or is returning the same LuaNil over and over again ok? */
+ retval = pmc_new(INTERP, dynclass_LuaNil);
+ return retval;
}
newcopy = retval->vtable->clone(INTERP, retval);
return newcopy;
@@ -148,13 +149,10 @@ A copy of the value is stored, otherwise
*/
void set_pmc_keyed (PMC* key, PMC* value) {
-
- /* XXX should check for "isa", not equality with "==", since LuaNil is
no singular anymore */
-
- if (key == Lua_Nil) {
+ if (dynclass_LuaNil == key->vtable->base_type) {
real_exception(INTERP, NULL, 1, "table index is nil");
}
- if (value == Lua_Nil) {
+ if (dynclass_LuaNil == value->vtable->base_type) {
Hash.SELF.delete_keyed(key);
}
else {
@@ -180,6 +178,22 @@ Return always false.
return dest;
}
+/*
+
+=item C<INTVAL is_equal (PMC* value)>
+
+The C<==> operation. Compares reference (not in depth).
+
+=cut
+
+*/
+ INTVAL is_equal (PMC* value) {
+ if (SELF == value)
+ return (INTVAL)1;
+ else
+ return (INTVAL)0;
+ }
+
/* Other metamethods */
PMC* add (PMC* value, PMC* dest) {
@@ -238,7 +252,9 @@ Return always false.
=head1 AUTHORS
-Original code by Klaas-Jan Stol.
+Francois Perrad
+
+Klaas-Jan Stol
=cut
Modified: trunk/languages/lua/lib/luapir.pir
==============================================================================
--- trunk/languages/lua/lib/luapir.pir (original)
+++ trunk/languages/lua/lib/luapir.pir Sun Jan 15 23:18:26 2006
@@ -32,8 +32,7 @@ lib/luapir.pir - Lua PIR Library
.sub checkany
.param pmc arg
- $I0 = defined arg
- if $I0, L1
+ unless_null arg, L1
argerror("value expected")
L1:
.end
Modified: trunk/languages/lua/t/expr.t
==============================================================================
--- trunk/languages/lua/t/expr.t (original)
+++ trunk/languages/lua/t/expr.t Sun Jan 15 23:18:26 2006
@@ -22,12 +22,9 @@ use strict;
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 7;
use Test::More;
-TODO: {
-local $TODO = "pb convertion.";
-
language_output_is( 'lua', <<'CODE', <<'OUT', 'relational op (by reference)' );
a = {}; a.x = 1; a.y = 0;
b = {}; b.x = 1; b.y = 0;
@@ -54,7 +51,12 @@ print(2<"15")
CODE
/compare/
OUT
-}
+
+language_output_like( 'lua', <<'CODE', <<'OUT', 'relational op' );
+print("2"<15)
+CODE
+/compare/
+OUT
language_output_is( 'lua', <<'CODE', <<'OUT', 'logical op' );
print(4 and 5)
Modified: trunk/languages/lua/t/lib/os.t
==============================================================================
--- trunk/languages/lua/t/lib/os.t (original)
+++ trunk/languages/lua/t/lib/os.t Sun Jan 15 23:18:26 2006
@@ -28,17 +28,13 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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 = "execute"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "execute"
.local pmc fct1
fct1 = os[key2]
+ .const .LuaString arg1 = 'perl -e "print \"test\n\"; exit(2)"'
.local pmc arg1
.local pmc ret1
new arg1, .LuaString
@@ -60,15 +56,10 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "exit"
.local pmc fct1
fct1 = os[key2]
.local pmc ret1
@@ -88,21 +79,14 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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 = "getenv"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "getenv"
.local pmc fct1
fct1 = os[key2]
- .local pmc arg1
+ .const .LuaString arg1 = "PARROT_TMP"
.local pmc ret1
- new arg1, .LuaString
- arg1 = "PARROT_TMP"
(ret1) = fct1(arg1)
print ret1
print "\n"
@@ -130,21 +114,14 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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 = "remove"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "remove"
.local pmc fct1
fct1 = os[key2]
- .local pmc arg1
+ .const .LuaString arg1 = "file.rm"
.local pmc ret1
- new arg1, .LuaString
- arg1 = "file.rm"
ret1 = fct1(arg1)
print ret1
print "\n"
@@ -164,22 +141,15 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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 = "remove"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "remove"
.local pmc fct1
fct1 = os[key2]
- .local pmc arg1
+ .const .LuaString arg1 = "file.rm"
.local pmc ret1
.local pmc msg1
- new arg1, .LuaString
- arg1 = "file.rm"
(ret1, msg1) = fct1(arg1)
print ret1
print "\n"
@@ -199,15 +169,10 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "f
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"
+ .const .LuaString key1 = "os"
+ .local pmc os
+ os = _G[key1]
+ .const .LuaString key2 = "time"
.local pmc fct1
fct1 = os[key2]
.local pmc ret1
Modified: trunk/languages/lua/t/pmc/boolean.t
==============================================================================
--- trunk/languages/lua/t/pmc/boolean.t (original)
+++ trunk/languages/lua/t/pmc/boolean.t Sun Jan 15 23:18:26 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
@@ -17,7 +17,7 @@ Tests C<LuaBoolean> PMC
=cut
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 7;
use Test::More;
pir_output_is(<< 'CODE', << 'OUTPUT', "check inheritance");
@@ -149,3 +149,20 @@ CODE
true
1
OUTPUT
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL & .const");
+.HLL "Lua", "lua_group"
+.sub _main
+ .const .LuaBoolean cst1 = "1"
+ print cst1
+ print "\n"
+ .local int bool1
+ bool1 = isa cst1, "LuaBoolean"
+ print bool1
+ print "\n"
+.end
+CODE
+true
+1
+OUTPUT
+
Modified: trunk/languages/lua/t/pmc/nil.t
==============================================================================
--- trunk/languages/lua/t/pmc/nil.t (original)
+++ trunk/languages/lua/t/pmc/nil.t Sun Jan 15 23:18:26 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
@@ -17,7 +17,7 @@ Tests C<LuaNil> PMC
=cut
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 12;
use Test::More;
pir_output_is(<< 'CODE', << 'OUTPUT', "check inheritance");
@@ -27,9 +27,6 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.local pmc pmc1
pmc1 = new $I0
.local int bool1
- bool1 = isa pmc1, "None"
- print bool1
- print "\n"
bool1 = isa pmc1, "LuaNil"
print bool1
print "\n"
@@ -37,7 +34,6 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
-1
OUTPUT
pir_output_is(<< 'CODE', << 'OUTPUT', "check interface");
@@ -149,42 +145,119 @@ true
boolean
OUTPUT
-pir_output_is(<< 'CODE', << 'OUTPUT', "check singleton");
+pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL");
+.HLL "Lua", "lua_group"
.sub _main
- loadlib P1, "lua_group"
- find_type $I0, "LuaNil"
.local pmc pmc1
- pmc1 = new $I0
- .local pmc pmc2
- pmc2 = new $I0
- .local int bool1
- bool1 = iseq pmc1, pmc2
- print bool1
+ pmc1 = new .LuaNil
+ print pmc1
print "\n"
- bool1 = issame pmc1, pmc2
+ .local int bool1
+ bool1 = isa pmc1, "LuaNil"
print bool1
print "\n"
end
.end
CODE
+nil
1
+OUTPUT
+
+TODO: {
+local $TODO = "not implemented.";
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL & .const");
+.HLL "Lua", "lua_group"
+.sub _main
+ .const .LuaNil cst1 = ""
+ print cst1
+ print "\n"
+ .local int bool1
+ bool1 = isa cst1, "LuaNil"
+ print bool1
+ print "\n"
+.end
+CODE
+nil
1
OUTPUT
+}
-pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL");
+pir_output_is(<< 'CODE', << 'OUTPUT', "morph to string");
.HLL "Lua", "lua_group"
.sub _main
.local pmc pmc1
pmc1 = new .LuaNil
print pmc1
print "\n"
- .local int bool1
- bool1 = isa pmc1, "LuaNil"
- print bool1
+ pmc1 = "text"
+ .local string str1
+ str1 = typeof pmc1
+ print str1
+ print "\n"
+ print pmc1
print "\n"
end
.end
CODE
nil
-1
+string
+text
OUTPUT
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "morph to boolean");
+.HLL "Lua", "lua_group"
+.sub _main
+ .local pmc pmc1
+ pmc1 = new .LuaNil
+ print pmc1
+ print "\n"
+ pmc1 = 1
+ .local string str1
+ str1 = typeof pmc1
+ print str1
+ print "\n"
+ print pmc1
+ print "\n"
+ end
+.end
+CODE
+nil
+boolean
+true
+OUTPUT
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "morph to number");
+.HLL "Lua", "lua_group"
+.sub _main
+ .local pmc pmc1
+ pmc1 = new .LuaNil
+ print pmc1
+ print "\n"
+ pmc1 = 3.14
+ .local string str1
+ str1 = typeof pmc1
+ print str1
+ print "\n"
+ print pmc1
+ print "\n"
+ .local pmc pmc2
+ pmc2 = new .LuaNil
+ $N2 = 2 # prevent morph to boolean
+ pmc2 = $N2
+ .local string str2
+ str2 = typeof pmc2
+ print str2
+ print "\n"
+ print pmc2
+ print "\n"
+ end
+.end
+CODE
+nil
+number
+3.14
+number
+2
+OUTPUT
+
Modified: trunk/languages/lua/t/pmc/number.t
==============================================================================
--- trunk/languages/lua/t/pmc/number.t (original)
+++ trunk/languages/lua/t/pmc/number.t Sun Jan 15 23:18:26 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
@@ -17,7 +17,7 @@ Tests C<LuaNumber> PMC
=cut
-use Parrot::Test tests => 7;
+use Parrot::Test tests => 9;
use Test::More;
pir_output_is(<< 'CODE', << 'OUTPUT', "check inheritance");
@@ -84,6 +84,34 @@ number
number
OUTPUT
+pir_output_is(<< 'CODE', << 'OUTPUT', "check set_integer_native");
+.sub _main
+ loadlib P1, "lua_group"
+ find_type $I0, "LuaNumber"
+ .local pmc pmc1
+ .local string str1
+ pmc1 = new $I0
+ pmc1 = 3.14
+ str1 = typeof pmc1
+ print str1
+ print "\n"
+ print pmc1
+ print "\n"
+ pmc1 = 2
+ str1 = typeof pmc1
+ print str1
+ print "\n"
+ print pmc1
+ print "\n"
+ end
+.end
+CODE
+number
+3.14
+number
+2
+OUTPUT
+
pir_output_is(<< 'CODE', << 'OUTPUT', "check get_bool");
.sub _main
loadlib P1, "lua_group"
@@ -168,3 +196,20 @@ CODE
3.14
1
OUTPUT
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL & .const");
+.HLL "Lua", "lua_group"
+.sub _main
+ .const .LuaNumber cst1 = "3.14"
+ print cst1
+ print "\n"
+ .local int bool1
+ bool1 = isa cst1, "LuaNumber"
+ print bool1
+ print "\n"
+.end
+CODE
+3.14
+1
+OUTPUT
+
Modified: trunk/languages/lua/t/pmc/string.t
==============================================================================
--- trunk/languages/lua/t/pmc/string.t (original)
+++ trunk/languages/lua/t/pmc/string.t Sun Jan 15 23:18:26 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
@@ -17,7 +17,7 @@ Tests C<LuaString> PMC
=cut
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 9;
use Test::More;
pir_output_is(<< 'CODE', << 'OUTPUT', "check inheritance");
@@ -184,3 +184,20 @@ CODE
simple string
1
OUTPUT
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "check HLL & .const");
+.HLL "Lua", "lua_group"
+.sub _main
+ .const .LuaString cst1 = "simple string"
+ print cst1
+ print "\n"
+ .local int bool1
+ bool1 = isa cst1, "LuaString"
+ print bool1
+ print "\n"
+.end
+CODE
+simple string
+1
+OUTPUT
+
