The enclosed patch makes a number of changes to perlstring.pmc, to bring
it in line with my understanding of how PMCs are supposed to work.
Specifically, unless we _know_ the type of the source and destination PMCs,
we should always access them through their get_... and set_... methods.
In practical terms, this means that in arithmetical ops, for instance,
we shouldn't change the vtable of the destination PMC: the only thing
that does that should be its own set_... ops (if changing the vtable is
appropriate). It also means that in concat ops, we should be assigning
directly to dest->data, as we have no idea what's actually stored there.
This patch makes the appropriate changes for add, sub, mul, div and
the concat_... ops; I haven't looked at the others in any detail yet.
In addition to the above, I also fix up the indentation in a few places
-- I can send this as a separate patch if necessary.
Finally, I also include a patch to perlstring.t that substantially
extends the test suite by providing basic tests for all of the
aforementioned ops.
Simon
--- classes/perlstring.pmc.old Tue Apr 9 14:26:06 2002
+++ classes/perlstring.pmc Wed Apr 10 14:35:55 2002
@@ -24,7 +24,7 @@
void init (INTVAL size) {
SELF->data = string_make(INTERP,NULL,0,NULL,0,NULL);
- SELF->flags = PMC_is_buffer_ptr_FLAG;
+ SELF->flags = PMC_is_buffer_ptr_FLAG;
}
void clone (PMC* dest) {
@@ -49,12 +49,12 @@
INTVAL get_integer () {
STRING* s = (STRING*) SELF->data;
- return string_to_int(s);
+ return string_to_int(s);
}
FLOATVAL get_number () {
STRING* s = (STRING*) SELF->data;
- return string_to_num(s);
+ return string_to_num(s);
}
STRING* get_string () {
@@ -62,7 +62,7 @@
}
BOOLVAL get_bool () {
- return string_bool(SELF->data);
+ return string_bool(SELF->data);
}
void* get_value () {
@@ -141,27 +141,28 @@
void add (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) +
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) +
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) +
value->cache.num_val
);
}
- else {
+ else {
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) +
+ value->vtable->get_number(INTERP,value)
+ );
}
}
void add_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) +
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) +
value
);
}
@@ -170,7 +171,6 @@
}
void add_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) +
value
@@ -185,27 +185,28 @@
void subtract (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) -
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) -
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) -
value->cache.num_val
);
}
else {
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) -
+ value->vtable->get_number(INTERP, value)
+ );
}
}
void subtract_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) -
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) -
value
);
}
@@ -214,7 +215,6 @@
}
void subtract_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) -
value
@@ -229,27 +229,28 @@
void multiply (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) *
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) *
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) *
value->cache.num_val
);
}
else {
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) *
+ value->vtable->get_number(INTERP, value)
+ );
}
}
void multiply_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) *
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) *
value
);
}
@@ -258,7 +259,6 @@
}
void multiply_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) *
value
@@ -273,27 +273,29 @@
void divide (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) /
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) /
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) /
value->cache.num_val
);
}
else {
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) /
+ value->vtable->get_number(INTERP, value)
+ );
+
}
}
void divide_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
- dest->vtable->set_integer_native(INTERP, dest,
- SELF->vtable->get_integer(INTERP, SELF) /
+ dest->vtable->set_number_native(INTERP, dest,
+ SELF->vtable->get_number(INTERP, SELF) /
value
);
}
@@ -302,7 +304,6 @@
}
void divide_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) /
value
@@ -317,7 +318,6 @@
void modulus (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) %
value->cache.int_val
@@ -328,7 +328,6 @@
}
void modulus_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) %
value
@@ -348,56 +347,53 @@
}
void concatenate (PMC * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->data);
- dest->data =
+ dest->vtable->set_string_native(INTERP, dest,
string_concat(INTERP,
- s,
+ string_copy(INTERP, (STRING*)SELF->data),
value->vtable->get_string(INTERP, value),
0
- );
- /* don't destroy s, as it is dest->data */
+ )
+ );
}
void concatenate_native (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->data);
- dest->data =
+ dest->vtable->set_string_native(INTERP, dest,
string_concat(INTERP,
- s,
+ string_copy(INTERP, (STRING*)SELF->data),
value,
0
- );
- /* don't destroy s, as it is dest->data */
+ )
+ );
}
void concatenate_unicode (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->data);
- dest->data =
+ dest->vtable->set_string_unicode(INTERP, dest,
string_concat(INTERP,
- s,
+ string_copy(INTERP, (STRING*)SELF->data),
value,
0
- );
- /* don't destroy s, as it is dest->data */
+ )
+ );
}
void concatenate_other (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->data);
- dest->data =
+ dest->vtable->set_string_other(INTERP, dest,
string_concat(INTERP,
- s,
+ string_copy(INTERP, (STRING*)SELF->data),
value,
0
- );
- /* don't destroy s, as it is dest->data */
+ )
+ );
}
void concatenate_same (PMC * value, PMC* dest) {
- dest->data =
+ dest->vtable->set_string_native(INTERP, dest,
string_concat(INTERP,
SELF->data,
value->data,
0
- );
+ )
+ );
}
/* == operation */
--- t/pmc/perlstring.t.old Tue Apr 9 14:08:46 2002
+++ t/pmc/perlstring.t Wed Apr 10 14:32:00 2002
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 30;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -46,6 +46,32 @@
endm
ENDOFMACRO
+output_is(<<'CODE', <<OUTPUT, "Creating a PerlString");
+ print "Starting\n"
+ new P0, PerlString
+ print "Ending\n"
+ end
+CODE
+Starting
+Ending
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "Creating lots of PerlStrings");
+ set I0, 0
+ print "Starting\n"
+
+FOO: inc I0
+ new P0, PerlString
+ lt I0, 10000, FOO
+
+ print "Ending\n"
+ end
+CODE
+Starting
+Ending
+OUTPUT
+
+
output_is(<<CODE, <<OUTPUT, "Set/get strings");
new P0, PerlString
set P0, "foo"
@@ -188,6 +214,702 @@
ok 6
OUTPUT
+output_is(<<"CODE", <<OUTPUT, "Creating new PMC clears old value");
+@{[ $fp_equality_macro ]}
+ new P0, PerlString
+ set P0, "Foo"
+ new P0, PerlString
+ set S0, P0
+ eq S0, "", OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P1, PerlString
+ set P1, 10.0
+ new P1, PerlString
+ set N1, P1
+ fp_eq N1, 0.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlString
+ set P2, 1
+ new P2, PerlString
+ set I2, P2
+ eq I2, 0, OK3
+ print "not "
+OK3: print "ok 3\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+OUTPUT
+
+
+# Arithmetic
+
+output_is(<<"CODE", <<OUTPUT, "Addition: (numeric) string + (numeric) string");
+@{[ $fp_equality_macro ]}
+ new P0, PerlString
+ new P1, PerlString
+ set P0, "2.0"
+ set P1, "10"
+
+ new P2, PerlString
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Addition: (numeric) string + int");
+@{[ $fp_equality_macro ]}
+ new P0, PerlInt
+ new P1, PerlString
+ set P0, 2
+ set P1, "10.0"
+
+ new P2, PerlString
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Addition: (numeric) string + num");
+@{[ $fp_equality_macro ]}
+ new P0, PerlNum
+ new P1, PerlString
+ set P0, 2.0
+ set P1, "10.0"
+
+ new P2, PerlString
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 12.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Addition: (numeric) string + undef");
+@{[ $fp_equality_macro ]}
+ new P0, PerlUndef
+ new P1, PerlString
+ set P1, "10.0"
+
+ new P2, PerlString
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ add P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Subtraction: string - string");
+@{[ $fp_equality_macro ]}
+ new P0, PerlString
+ new P1, PerlString
+ set P0, "2.0"
+ set P1, "10"
+
+ new P2, PerlString
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 8.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 8.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 8.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 8.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Subtraction: string - int");
+@{[ $fp_equality_macro ]}
+ new P0, PerlInt
+ new P1, PerlString
+ set P0, 11
+ set P1, "10"
+
+ new P2, PerlString
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, -1.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, -1.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, -1.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, -1.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Subtraction: string - num");
+@{[ $fp_equality_macro ]}
+ new P0, PerlNum
+ new P1, PerlString
+ set P0, 5.5
+ set P1, "10"
+
+ new P2, PerlString
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 4.5, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 4.5, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 4.5, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 4.5, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Subtraction: string - undef");
+@{[ $fp_equality_macro ]}
+ new P0, PerlUndef
+ new P1, PerlString
+ set P1, "10"
+
+ new P2, PerlString
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ sub P2, P1, P0
+ set N0, P2
+ fp_eq N0, 10.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Multiplication: string * string");
+@{[ $fp_equality_macro ]}
+ new P0, PerlString
+ new P1, PerlString
+ set P0, "2.0"
+ set P1, "10"
+
+ new P2, PerlString
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 20.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 20.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 20.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 20.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Multiplication: string * int");
+@{[ $fp_equality_macro ]}
+ new P0, PerlInt
+ new P1, PerlString
+ set P0, -1
+ set P1, "-1"
+
+ new P2, PerlString
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 1.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 1.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 1.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 1.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Multiplication: string * num");
+@{[ $fp_equality_macro ]}
+ new P0, PerlNum
+ new P1, PerlString
+ set P0, 3.0
+ set P1, "3"
+
+ new P2, PerlString
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 9.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 9.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 9.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 9.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Multiplication: string * undef");
+@{[ $fp_equality_macro ]}
+ new P0, PerlUndef
+ new P1, PerlString
+ set P1, "3"
+
+ new P2, PerlString
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 0.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 0.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 0.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ mul P2, P1, P0
+ set N0, P2
+ fp_eq N0, 0.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Division: string / string");
+@{[ $fp_equality_macro ]}
+ new P0, PerlString
+ new P1, PerlString
+ set P0, "2.0"
+ set P1, "10"
+
+ new P2, PerlString
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Division: string / int");
+@{[ $fp_equality_macro ]}
+ new P0, PerlInt
+ new P1, PerlString
+ set P0, 2
+ set P1, "10"
+
+ new P2, PerlString
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Division: string / num");
+@{[ $fp_equality_macro ]}
+ new P0, PerlNum
+ new P1, PerlString
+ set P0, 2.0
+ set P1, "10"
+
+ new P2, PerlString
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK1
+
+ print "not "
+OK1: print "ok 1\\n"
+ new P2, PerlNum
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK2
+
+ print "not "
+OK2: print "ok 2\\n"
+ new P2, PerlInt
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK3
+
+ print "not "
+OK3: print "ok 3\\n"
+ new P2, PerlUndef
+ div P2, P1, P0
+ set N0, P2
+ fp_eq N0, 5.0, OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+SKIP: {
+skip("Pending exception handling",1);
+
+output_is(<<"CODE", <<OUTPUT, "Division: string / undef");
+@{[ $fp_equality_macro ]}
+ new P0, PerlUndef
+ new P1, PerlString
+ set P1, "10"
+
+ new P2, PerlString
+ div P2, P1, P0
+CODE
+OUTPUT
+}
+
+
+#Stringy ops:
+
output_is(<<CODE, <<OUTPUT, "ensure that concat ppp copies strings");
new P0, PerlString
new P1, PerlString
@@ -220,6 +942,107 @@
You can't teach an old dog new...clear physics
OUTPUT
+output_is(<<CODE, <<OUTPUT, "concat string & int");
+ new P0, PerlInt
+ new P1, PerlString
+ set P0, 1234
+ set P1, "abcd"
+
+ new P2, PerlString
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlInt
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlNum
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlUndef
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ end
+CODE
+abcd1234
+abcd1234
+abcd1234
+abcd1234
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "concat string & num");
+ new P0, PerlNum
+ new P1, PerlString
+ set P0, 12.345678
+ set P1, "abcd"
+
+ new P2, PerlString
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlInt
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlNum
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlUndef
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ end
+CODE
+abcd12.345678
+abcd12.345678
+abcd12.345678
+abcd12.345678
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "concat string & undef");
+ new P0, PerlUndef
+ new P1, PerlString
+ set P1, "abcd"
+
+ new P2, PerlString
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlInt
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlNum
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ new P2, PerlUndef
+ concat P2, P1, P0
+ print P2
+ print "\\n"
+
+ end
+CODE
+abcd
+abcd
+abcd
+abcd
+OUTPUT
+
SKIP: {
skip("Pending new version of concat_p_p_s",1);
output_is(<<CODE, <<OUTPUT, "ensure that concat pps copies strings");
@@ -300,8 +1123,6 @@
OUTPUT
-
-
output_is(<<CODE, <<OUTPUT, "if(PerlString)");
new P0, PerlString
set S0, "True"
