cvsuser 04/06/18 06:44:28
Modified: classes perlstring.pmc
t/pmc perlstring.t
Log:
partial implementation of PerlString inc & dec
Revision Changes Path
1.74 +28 -23 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- perlstring.pmc 18 Jun 2004 06:46:23 -0000 1.73
+++ perlstring.pmc 18 Jun 2004 13:44:24 -0000 1.74
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.73 2004/06/18 06:46:23 leo Exp $
+$Id: perlstring.pmc,v 1.74 2004/06/18 13:44:24 leo Exp $
=head1 NAME
@@ -561,7 +561,6 @@
*/
void repeat (PMC* value, PMC* dest) {
- DYNSELF.morph(enum_class_PerlString);
VTABLE_morph(INTERP, dest, enum_class_PerlString);
PMC_str_val(dest) =
string_repeat(INTERP, PMC_str_val(SELF),
@@ -580,7 +579,6 @@
*/
void repeat_int (INTVAL value, PMC* dest) {
- DYNSELF.morph(enum_class_PerlString);
VTABLE_morph(INTERP, dest, enum_class_PerlString);
PMC_str_val(dest) = string_repeat(INTERP,
PMC_str_val(SELF), (UINTVAL)value, NULL);
@@ -590,27 +588,34 @@
=item C<void increment()>
-=cut
-
-*/
-
- void increment () {
- /* XXX perl5 like= */
- }
-
-/*
-
=item C<void decrement()>
-These two methods are unimplemented and do nothing. They should provide
-Perl 5 like string incrementation.
+These two methods are partially implemented. They should provide
+Perl 5 like string increment/decrement.
=cut
*/
+ void increment () {
+ STRING* s = PMC_str_val(SELF);
+ INTVAL o;
+ if (string_length(INTERP, s) != 1)
+ internal_exception(1, "increment only for length=1 done");
+ o = string_ord(INTERP, s, 0);
+ if ((o >= 'A' && o < 'Z') ||
+ (o >= 'a' && o < 'z')) {
+ ++o;
+ /* TODO increment in place */
+ PMC_str_val(SELF) = string_chr(INTERP, o);
+ return;
+ }
+ internal_exception(1, "increment out of range - unimplemented");
+ }
+
void decrement () {
- /* XXX perl5 like= */
+ INTVAL i = VTABLE_get_integer(INTERP, SELF);
+ VTABLE_set_integer_native(INTERP, SELF, i - 1);
}
/*
1.24 +38 -2 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- perlstring.t 24 May 2004 13:47:00 -0000 1.23
+++ perlstring.t 18 Jun 2004 13:44:28 -0000 1.24
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.23 2004/05/24 13:47:00 leo Exp $
+# $Id: perlstring.t,v 1.24 2004/06/18 13:44:28 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 35;
+use Parrot::Test tests => 37;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -1099,5 +1099,41 @@
str
OUTPUT
+output_is( <<'CODE', <<OUTPUT, "increment");
+ new P0, .PerlString
+ set P0, 'a'
+ inc P0
+ print P0
+ inc P0
+ print P0
+ set P0, 'E'
+ inc P0
+ print P0
+ inc P0
+ print P0
+ print "\n"
+ end
+CODE
+bcFG
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "decrement");
+ new P0, .PerlString
+ set P0, '9'
+ dec P0
+ print P0
+ dec P0
+ print P0
+ set P0, '-7'
+ dec P0
+ print P0
+ dec P0
+ print P0
+ print "\n"
+ end
+CODE
+87-8-9
+OUTPUT
+
1;
