This makes PerlUndef somewhat functional by adding logical,
arithmetic, and repeat methods.
Index: global_setup.c
===================================================================
RCS file: /home/perlcvs/parrot/global_setup.c,v
retrieving revision 1.12
diff -u -r1.12 global_setup.c
--- global_setup.c 1 Jan 2002 03:46:40 -0000 1.12
+++ global_setup.c 4 Jan 2002 18:59:12 -0000
@@ -25,6 +25,7 @@
string_init(); /* Set up the string subsystem */
/* Call base vtable class constructor methods! */
+ Parrot_PerlUndef_class_init();
Parrot_PerlInt_class_init();
Parrot_PerlNum_class_init();
Parrot_PerlString_class_init();
Index: classes/perlundef.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/perlundef.pmc,v
retrieving revision 1.2
diff -u -r1.2 perlundef.pmc
--- classes/perlundef.pmc 18 Dec 2001 07:05:00 -0000 1.2
+++ classes/perlundef.pmc 4 Jan 2002 18:59:12 -0000
@@ -59,7 +59,7 @@
}
STRING* get_string () {
- return NULL;
+ return string_make(INTERP,NULL,0,NULL,0,NULL);
}
STRING* get_string_index (INTVAL index) {
@@ -154,75 +154,139 @@
}
void add (PMC * value, PMC* dest) {
+ if(value->vtable == &Parrot_base_vtables[enum_class_PerlUndef]) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
+ }
+ else if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
+ dest->vtable->set_integer(INTERP, dest, value);
+ }
+ else {
+ dest->vtable->set_number(INTERP, dest, value);
+ }
}
void add_int (INTVAL value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, value);
}
void add_bigint (BIGINT value, PMC* dest) {
}
void add_float (FLOATVAL value, PMC* dest) {
+ dest->vtable->set_number_native(INTERP, dest, value);
}
void add_bigfloat (BIGFLOAT value, PMC* dest) {
}
void add_same (PMC * value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void subtract (PMC * value, PMC* dest) {
+ if(value->vtable == &Parrot_base_vtables[enum_class_PerlUndef]) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
+ }
+ else if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
+ dest->vtable->set_integer_native(INTERP, dest,
+ -value->vtable->get_integer(INTERP, value));
+ }
+ else {
+ dest->vtable->set_number_native(INTERP, dest,
+ -value->vtable->get_number(INTERP, value));
+ }
}
void subtract_int (INTVAL value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, -value);
}
void subtract_bigint (BIGINT value, PMC* dest) {
}
void subtract_float (FLOATVAL value, PMC* dest) {
+ dest->vtable->set_number_native(INTERP, dest, -value);
}
void subtract_bigfloat (BIGFLOAT value, PMC* dest) {
}
void subtract_same (PMC * value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply (PMC * value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply_int (INTVAL value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply_bigint (BIGINT value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply_float (FLOATVAL value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply_bigfloat (BIGFLOAT value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void multiply_same (PMC * value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide (PMC * value, PMC* dest) {
+ if(value->vtable == &Parrot_base_vtables[enum_class_PerlUndef]) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
+ }
+ else if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
+ if(value->vtable->get_integer(INTERP, value) == 0) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
+ }
+ }
+ else if(value->vtable->get_number(INTERP, value) == 0) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
+ }
+
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide_int (INTVAL value, PMC* dest) {
+ if(value == 0) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
+ }
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide_bigint (BIGINT value, PMC* dest) {
+ /* need test for value == 0 */
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide_float (FLOATVAL value, PMC* dest) {
+ if(value == 0) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
+ }
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide_bigfloat (BIGFLOAT value, PMC* dest) {
+ /* need test for value == 0 */
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
void divide_same (PMC * value, PMC* dest) {
+ fprintf(stderr, "division by zero!\n");
+ exit(1);
}
void modulus (PMC * value, PMC* dest) {
@@ -262,12 +326,16 @@
}
void logical_or (PMC* value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest,
+ value->vtable->get_bool(INTERP, value));
}
void logical_and (PMC* value, PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 0);
}
- void logical_not (PMC* value) {
+ void logical_not (PMC* dest) {
+ dest->vtable->set_integer_native(INTERP, dest, 1);
}
void match (PMC * value, REGEX* re) {
@@ -286,18 +354,28 @@
}
void repeat (PMC * value, PMC* dest) {
+ dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ dest->cache.struct_val = string_make(INTERP, NULL,0,NULL,0, NULL);
}
void repeat_native (STRING * value, PMC* dest) {
+ dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ dest->cache.struct_val = string_make(INTERP, NULL,0,NULL,0, NULL);
}
void repeat_unicode (STRING * value, PMC* dest) {
+ dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ dest->cache.struct_val = string_make(INTERP, NULL,0,NULL,0, NULL);
}
void repeat_other (STRING * value, PMC* dest) {
+ dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ dest->cache.struct_val = string_make(INTERP, NULL,0,NULL,0, NULL);
}
void repeat_same (PMC * value, PMC* dest) {
+ dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ dest->cache.struct_val = string_make(INTERP, NULL,0,NULL,0, NULL);
}
}
Index: t/op/pmc.t
===================================================================
RCS file: /home/perlcvs/parrot/t/op/pmc.t,v
retrieving revision 1.16
diff -u -r1.16 pmc.t
--- t/op/pmc.t 27 Dec 2001 18:50:28 -0000 1.16
+++ t/op/pmc.t 4 Jan 2002 18:59:12 -0000
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 47;
+use Parrot::Test tests => 52;
my $fp_equality_macro = <<'ENDOFMACRO';
fp_eq macro J,K,L
@@ -947,6 +947,173 @@
ok 7
ok 8
ok 9
+OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-logical");
+ new P0, PerlUndef
+ new P1, PerlUndef
+ new P2, PerlInt
+
+# undef or undef = 0
+ or P0, P1, P1
+ print P0
+
+# undef and undef = 0
+ and P0, P1, P1
+ print P0
+
+# undef or 1 = 1
+ set P2, 349
+ or P0, P1, P2
+ print P0
+
+# undef and 1 = 0
+ and P0, P1, P2
+ print P0
+
+# not undef = 1
+ not P0, P1
+ print "x"
+ print P1
+ print "y"
+ print P0
+ print "z"
+ print "\\n"
+ end
+CODE
+0010xy1z
+OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-add");
+@{[ $fp_equality_macro ]}
+ new P1, PerlUndef
+
+# undef + perlundef
+ new P0, PerlUndef
+ add P0, P1, P1
+ print P0
+ print "\\n"
+
+# undef + perlint
+
+ new P0, PerlUndef
+ new P2, PerlInt
+ set P2, 947
+ add P0, P1, P2
+ print P0
+ print "\\n"
+
+# undef + perlnum
+
+ new P0, PerlUndef
+ new P2, PerlNum
+ set P2, 385.623
+ add P0, P1, P2
+ fp_eq P0, 385.623, OK
+
+ print "not"
+OK: print "ok"
+ print "\\n"
+
+ end
+CODE
+0
+947
+ok
+OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-subtract");
+@{[ $fp_equality_macro ]}
+ new P0, PerlUndef
+ new P1, PerlUndef
+
+# undef - undef
+ sub P0, P1, P1
+ print P0
+ print "\\n"
+
+# undef - perlint
+ new P2, PerlInt
+ set P2, 947
+ sub P0, P1, P2
+ print P0
+ print "\\n"
+
+# undef - perlnum
+
+ new P2, PerlNum
+ set P2, 385.623
+ sub P0, P1, P2
+ fp_eq P0, -385.623, OK2
+
+ print "not"
+OK2: print "ok"
+ print "\\n"
+
+
+ end
+CODE
+0
+-947
+ok
+OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-multiply");
+@{[ $fp_equality_macro ]}
+
+ new P0, PerlUndef
+ new P1, PerlUndef
+ new P2, PerlInt
+
+# Undef * Undef
+ mul P0, P1, P1
+ print P0
+ print "\\n"
+
+# Undef * PerlInt
+ set P2, 983
+ mul P0, P1, P2
+ print P0
+ print "\\n"
+
+# Undef * PerlNum
+ new P2, PerlNum
+ set P2, 983.3
+ mul P0, P1, P2
+ print P0
+ print "\\n"
+
+ end
+CODE
+0
+0
+0
+OUTPUT
+
+output_is(<<"CODE", <<'OUTPUT', "undef-divide");
+@{[ $fp_equality_macro ]}
+
+ new P0, PerlUndef
+ new P1, PerlUndef
+ new P2, PerlInt
+
+# Undef / PerlInt
+ set P2, 19
+ div P0, P1, P2
+ print P0
+ print "\\n"
+
+# Undef / PerlNum
+ new P2, PerlNum
+ set P2, 343.8
+ div P0, P1, P2
+ print P0
+ print "\\n"
+
+ end
+CODE
+0
+0
OUTPUT
1;
