cvsuser 05/01/05 07:34:19
Modified: classes perlstring.pmc
t/pmc perlstring.t
Log:
Use MMD for subtract op
Revision Changes Path
1.92 +26 -15 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.91
retrieving revision 1.92
diff -u -r1.91 -r1.92
--- perlstring.pmc 12 Dec 2004 23:03:45 -0000 1.91
+++ perlstring.pmc 5 Jan 2005 15:34:18 -0000 1.92
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.91 2004/12/12 23:03:45 chromatic Exp $
+$Id: perlstring.pmc,v 1.92 2005/01/05 15:34:18 scog Exp $
=head1 NAME
@@ -158,21 +158,32 @@
*/
void subtract (PMC* value, PMC* dest) {
- if(value->vtable == Parrot_base_vtables[enum_class_PerlInt]) {
- VTABLE_set_integer_native(INTERP, dest,
- VTABLE_get_integer(INTERP, SELF) -
- PMC_int_val(value)
- );
- }
- else if(value->vtable == Parrot_base_vtables[enum_class_PerlNum]) {
- VTABLE_set_number_native(INTERP, dest,
- VTABLE_get_number(INTERP, SELF) -
- PMC_num_val(value)
- );
- }
- else {
- SUPER(value, dest);
+MMD_PerlString: {
+ /* work around MMD setup bug */
+ VTABLE_set_number_native(INTERP, dest,
+ VTABLE_get_number(INTERP, SELF) -
+ VTABLE_get_number(INTERP, value));
}
+MMD_PerlNum: {
+ VTABLE_set_number_native(INTERP, dest,
+ VTABLE_get_number(INTERP, SELF) -
+ PMC_num_val(value)
+ );
+ }
+MMD_DEFAULT: {
+ FLOATVAL pmcf, valf;
+ INTVAL pmci, vali;
+
+ pmcf = VTABLE_get_number(INTERP, SELF);
+ pmci = VTABLE_get_integer(INTERP, SELF);
+ valf = VTABLE_get_number(INTERP, value);
+ vali = VTABLE_get_integer(INTERP, value);
+
+ if (pmcf == pmci && valf == vali)
+ VTABLE_set_integer_native(INTERP, dest, pmci - vali);
+ else
+ VTABLE_set_number_native(INTERP, dest, pmcf - valf);
+ }
}
/*
1.31 +79 -2 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- perlstring.t 16 Dec 2004 19:22:46 -0000 1.30
+++ perlstring.t 5 Jan 2005 15:34:19 -0000 1.31
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.30 2004/12/16 19:22:46 chromatic Exp $
+# $Id: perlstring.t,v 1.31 2005/01/05 15:34:19 scog Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 41;
+use Parrot::Test tests => 46;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -479,6 +479,83 @@
ok 1
OUTPUT
+output_is(<<'CODE', <<OUTPUT, "sub str_int, str_int");
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlString
+ set P1, "2"
+ new P2, .PerlUndef
+ sub P2, P0, P1
+ print P2
+ print "\n"
+ end
+CODE
+21
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "sub str_int, str_num");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlString
+ set P1, "2.5"
+ new P2, .PerlUndef
+ sub P2, P0, P1
+ .fp_eq(P2, 20.5, EQ1)
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "sub str_int, int");
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlInt
+ set P1, 2
+ new P2, .PerlUndef
+ sub P2, P0, P1
+ print P2
+ print "\n"
+ end
+CODE
+21
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "sub str_int, num");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlNum
+ set P1, 2.5
+ new P2, .PerlUndef
+ sub P2, P0, P1
+ .fp_eq(P2, 20.5, EQ1)
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "sub str_num, int");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "23.5"
+ new P1, .PerlInt
+ set P1, 2
+ new P2, .PerlUndef
+ sub P2, P0, P1
+ .fp_eq(P2, 21.5, EQ1)
+ print P2
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
output_is(<<'CODE', <<OUTPUT, "concat must morph dest to a string");
new P0, .PerlString
new P1, .PerlUndef
