OK, I've revised the tests for C<set Sx, Px> in line with Alex's
concerns, and added explicit tests for PerlInts and PerlNums. As yet
there are still no PerlArray or PerlHash tests.
Re the former, am I right in thinking that assignment from a PerlArray
to a non-PMC register should always be in scalar context; ie that:
new P0, PerlArray
set S0, P0
should lead to S0 having the value "0" and not ""?
Simon
--- core.ops.old Fri Feb 1 15:57:44 2002
+++ core.ops Fri Feb 1 15:59:10 2002
@@ -527,6 +527,11 @@
goto NEXT();
}
+inline op set(out STR, in PMC) {
+ $1 = $2->vtable->get_string(interpreter, $2);
+ goto NEXT();
+}
+
inline op set(out STR, in STR) {
$1 = string_copy(interpreter, $2);
goto NEXT();
--- t/pmc/pmc.t.old Mon Feb 4 13:55:15 2002
+++ t/pmc/pmc.t Mon Feb 4 15:13:20 2002
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 58;
+use Parrot::Test tests => 61;
use Test::More;
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -816,7 +816,103 @@
foo
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "set/get string value");
+ new P0, PerlInt
+ set P0, "foo"
+ set S0, P0
+ eq S0, "foo", OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ set P0, "\0"
+ set S0, P0
+ eq S0, "\0", OK2
+ print "not "
+OK2: print "ok 2\n"
+
+ set P0, ""
+ set S0, P0
+ eq S0, "", OK3
+ print "not "
+OK3: print "ok 3\n"
+
+ set P0, 0
+ set S0, P0
+ eq S0, "0", OK4
+ print "not "
+OK4: print "ok 4\n"
+
+ set P0, 0.0
+ set S0, P0
+ eq S0, "0.000000", OK5
+ print "not "
+OK5: print "ok 5\n"
+
+ set P0, "0b000001"
+ set S0, P0
+ eq S0, "0b000001", OK6
+ print "not "
+OK6: print "ok 6\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+OUTPUT
+
+# The same for PerlNums...
+
+output_is(<<'CODE', <<'OUTPUT', "set/get string value");
+ new P0, PerlNum
+ set P0, "bar"
+ set S0, P0
+ eq S0, "bar", OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ set P0, "\0"
+ set S0, P0
+ eq S0, "\0", OK2
+ print "not "
+OK2: print "ok 2\n"
+
+ set P0, ""
+ set S0, P0
+ eq S0, "", OK3
+ print "not "
+OK3: print "ok 3\n"
+
+ set P0, -1
+ set S0, P0
+ eq S0, "-1", OK4
+ print "not "
+OK4: print "ok 4\n"
+
+ set P0, -1.0
+ set S0, P0
+ eq S0, "-1.000000", OK5
+ print "not "
+OK5: print "ok 5\n"
+
+ set P0, "1.23e23"
+ set S0, P0
+ eq S0, "1.23e23", OK6
+ print "not "
+OK6: print "ok 6\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+OUTPUT
output_is(<<CODE, <<OUTPUT, "if (P) - Int");
new P0, PerlInt
@@ -1255,6 +1351,18 @@
0
0
OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-string");
+ new P0, PerlUndef
+ set S0, P0
+ eq S0, "", OK
+ print "not "
+OK: print "ok\\n"
+ end
+CODE
+ok
+OUTPUT
+
output_is(<<CODE, <<OUTPUT, "IntQueue test");
new P0,IntQueue
--- t/pmc/perlstring.t.old Mon Feb 4 13:55:26 2002
+++ t/pmc/perlstring.t Mon Feb 4 15:05:58 2002
@@ -1,6 +1,54 @@
#! perl -w
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 6;
+
+output_is(<<CODE, <<OUTPUT, "Set/get strings");
+ new P0, PerlString
+ set P0, "foo"
+ set S0, P0
+ eq S0, "foo", OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, "\0"
+ set S0, P0
+ eq S0, "\0", OK2
+ print "not "
+OK2: print "ok 2\\n"
+
+ set P0, ""
+ set S0, P0
+ eq S0, "", OK3
+ print "not "
+OK3: print "ok 3\\n"
+
+ set P0, 123
+ set S0, P0
+ eq S0, "123", OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ set P0, 1.234567
+ set S0, P0
+ eq S0, "1.234567", OK5
+ print "not "
+OK5: print "ok 5\\n"
+
+ set P0, "0xFFFFFF"
+ set S0, P0
+ eq S0, "0xFFFFFF", OK6
+ print "not "
+OK6: print "ok 6\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+OUTPUT
output_is(<<CODE, <<OUTPUT, "ensure that concat ppp copies strings");
new P0, PerlString
