cvsuser 03/08/19 07:05:49
Modified: classes perlstring.pmc
. key.c
t/pmc iter.t
Log:
perlstring iterator interface
Revision Changes Path
1.45 +75 -1 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -w -r1.44 -r1.45
--- perlstring.pmc 8 Aug 2003 08:12:21 -0000 1.44
+++ perlstring.pmc 19 Aug 2003 14:05:44 -0000 1.45
@@ -1,7 +1,7 @@
/* perlstring.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlstring.pmc,v 1.44 2003/08/08 08:12:21 leo Exp $
+ * $Id: perlstring.pmc,v 1.45 2003/08/19 14:05:44 leo Exp $
* Overview:
* These are the vtable functions for the PerlString base class
* Data Structure and Algorithms:
@@ -354,5 +354,79 @@
STRING* substr_str (INTVAL offset, INTVAL length) {
return string_substr(INTERP, SELF->cache.string_val, offset,
length, NULL, 0);
+ }
+ /*
+ * iterator interface
+ */
+ PMC* nextkey_keyed (PMC* key, INTVAL what) {
+ PMC *ret = key;
+ STRING *s = SELF->cache.string_val;
+ INTVAL n = string_length(s);
+
+ PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
+ PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
+ switch (what) {
+ case 0: /* reset key, iterate from start */
+ ret->cache.int_val = 0;
+ if (!n)
+ ret->cache.int_val = -1;
+ PMC_data(key) = s->strstart;
+ break;
+ case 1: /* next key */
+ if (ret->cache.int_val < n - 1) {
+ ++ret->cache.int_val;
+ if ((char *)PMC_data(key) >= (char *)s->strstart &&
+ (char *)PMC_data(key) <= (char *)s->strstart +
+ s->bufused)
+ (const char *)PMC_data(key) =
+ s->encoding->skip_forward( PMC_data(key), 1);
+ else
+ (const char *)PMC_data(key) =
+ s->encoding->skip_forward(s->strstart,
+ ret->cache.int_val);
+ }
+ else
+ ret->cache.int_val = -1;
+ break;
+ case 2: /* prev key */
+ if (ret->cache.int_val >= 0) {
+ --ret->cache.int_val;
+ if (ret->cache.int_val >= 0) {
+ if ((char *)PMC_data(key) >= (char *)s->strstart &&
+ (char *)PMC_data(key) <= (char *)s->strstart +
+ s->bufused)
+ (const char *)PMC_data(key) =
+ s->encoding->skip_backward( PMC_data(key), 1);
+ else
+ (const char *)PMC_data(key) =
+ s->encoding->skip_forward(s->strstart,
+ ret->cache.int_val);
+ }
+ }
+ break;
+ case 3: /* reset key, iterate from end */
+ ret->cache.int_val = n;
+ PMC_data(key) = (char *)s->strstart + s->bufused;
+ break;
+ }
+ return ret;
+ }
+
+ STRING* get_string_keyed(PMC* key) {
+ STRING *res;
+ STRING *s = SELF->cache.string_val;
+ if ((char*)PMC_data(key) >= (char *)s->strstart &&
+ (char *)PMC_data(key) <= (char *)s->strstart + s->bufused)
+ ;
+ else
+ (const char *)PMC_data(key) = s->encoding->skip_forward(s->strstart,
+ key->cache.int_val);
+ res = string_copy(interpreter, s);
+ res->strstart = PMC_data(key);
+ res->strlen = 1;
+ res->bufused = (const char *)res->encoding->skip_forward(
+ res->strstart, 1) - (const char *)res->strstart;
+ return res;
+
}
}
1.43 +3 -1 parrot/key.c
Index: key.c
===================================================================
RCS file: /cvs/public/parrot/key.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- key.c 12 Aug 2003 14:39:16 -0000 1.42
+++ key.c 19 Aug 2003 14:05:46 -0000 1.43
@@ -1,7 +1,7 @@
/* key.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: key.c,v 1.42 2003/08/12 14:39:16 leo Exp $
+ * $Id: key.c,v 1.43 2003/08/19 14:05:46 leo Exp $
* Overview:
* The base vtable calling functions.
* Data Structure and Algorithms:
@@ -241,6 +241,8 @@
if ( ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_string_FLAG) ||
((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_pmc_FLAG) )
pobject_lives(interpreter, (PObj *)key->cache.string_val);
+ if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG)
+ return;
if (PMC_data(key))
pobject_lives(interpreter, (PObj *)PMC_data(key));
1.6 +40 -1 parrot/t/pmc/iter.t
Index: iter.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/iter.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- iter.t 6 Jul 2003 15:22:39 -0000 1.5
+++ iter.t 19 Aug 2003 14:05:49 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 8;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new iter");
new P2, .PerlArray
@@ -230,6 +230,45 @@
4
OUTPUT
+output_is(<<'CODE', <<OUTPUT, "string iteration forward");
+ new P2, .PerlString
+ set P2, "parrot"
+ new P1, .Iterator, P2
+ set P1, 0
+iter_loop:
+ unless P1, iter_end # while (entries) ...
+ shift S1, P1
+ print S1
+ branch iter_loop
+iter_end:
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+parrot
+parrot
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "string iteration backward");
+ new P2, .PerlString
+ set P2, "parrot"
+ new P1, .Iterator, P2
+ set P1, 3
+iter_loop:
+ unless P1, iter_end # while (entries) ...
+ pop S1, P1
+ print S1
+ branch iter_loop
+iter_end:
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+torrap
+parrot
+OUTPUT
SKIP: {
skip("N/Y: get_keyed_int gets rest of array", 1);
output_is(<<'CODE', <<'OUTPUT', "shift + index access");
