cvsuser 05/01/05 12:57:22
Modified: classes perlstring.pmc
t/pmc perlstring.t
Log:
Use MMD for multiply, too.
Revision Changes Path
1.93 +32 -19 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.92
retrieving revision 1.93
diff -u -r1.92 -r1.93
--- perlstring.pmc 5 Jan 2005 15:34:18 -0000 1.92
+++ perlstring.pmc 5 Jan 2005 20:57:21 -0000 1.93
@@ -1,6 +1,6 @@
/*
-Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.92 2005/01/05 15:34:18 scog Exp $
+Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+$Id: perlstring.pmc,v 1.93 2005/01/05 20:57:21 scog Exp $
=head1 NAME
@@ -8,7 +8,9 @@
=head1 DESCRIPTION
-C<PerlString> extends C<perlscalar> to provide Perl string behaviour.
+C<PerlString> extends C<String> to provide Perl-specific string behaviour.
+Note that the C<morph> and C<set_pmc> methods come from C<PerlScalar>,
+not from C<String>.
=head2 Methods
@@ -85,7 +87,7 @@
=item C<void set_pmc(PMC *value)>
-Sets the value of the number to the value in C<*value>.
+Sets the value of the PMC to the value in C<*value>.
=cut
@@ -99,7 +101,7 @@
=item C<void morph(INTVAL type)>
-Morphs the scalar to the specified type.
+Morphs the C<PerlString> to the specified type.
=cut
@@ -197,21 +199,32 @@
*/
void multiply (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.33 +110 -2 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- perlstring.t 5 Jan 2005 15:44:35 -0000 1.32
+++ perlstring.t 5 Jan 2005 20:57:21 -0000 1.33
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.32 2005/01/05 15:44:35 scog Exp $
+# $Id: perlstring.t,v 1.33 2005/01/05 20:57:21 scog Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 48;
+use Parrot::Test tests => 54;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -618,6 +618,114 @@
ok 3
OUTPUT
+output_is(<<'CODE', <<OUTPUT, "mul str_int, str_int");
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlString
+ set P1, "2"
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ print P2
+ print "\n"
+ end
+CODE
+46
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "mul str_int, str_num");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "5"
+ new P1, .PerlString
+ set P1, "2.5"
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ .fp_eq(P2, 12.5, EQ1)
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "mul str_int, int");
+ new P0, .PerlString
+ set P0, "23"
+ new P1, .PerlInt
+ set P1, 2
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ print P2
+ print "\n"
+ end
+CODE
+46
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "mul str_int, num");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "19"
+ new P1, .PerlNum
+ set P1, 2.5
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ .fp_eq(P2, 47.5, EQ1)
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "mul str_num, int");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "23.4"
+ new P1, .PerlInt
+ set P1, 2
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ .fp_eq(P2, 46.8, EQ1)
+ print P2
+ print "not "
+EQ1: print "ok 1\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+# XXX - should test for appropriate warnings
+output_is(<<"CODE", <<OUTPUT, "mul non-numeric string");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .PerlString
+ set P0, "24"
+ new P1, .PerlString
+ set P1, "Oklahoma"
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ eq P2, 0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+ set P0, "5.12"
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ .fp_eq(P2, 0.0, OK2)
+ print "not "
+OK2: print "ok 2\\n"
+ set P0, "Virginia Tech"
+ new P2, .PerlUndef
+ mul P2, P0, P1
+ eq P2, 0, OK3
+ print "not "
+OK3: print "ok 3\\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+OUTPUT
+
output_is(<<'CODE', <<OUTPUT, "concat must morph dest to a string");
new P0, .PerlString
new P1, .PerlUndef
