cvsuser 04/06/25 03:20:08
Modified: classes perlhash.pmc slice.pmc
src call_list.txt
t/pmc iter.t
Log:
Pie-thon 8 - fromkeys
Revision Changes Path
1.74 +43 -1 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- perlhash.pmc 24 Jun 2004 16:48:59 -0000 1.73
+++ perlhash.pmc 25 Jun 2004 10:19:52 -0000 1.74
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlhash.pmc,v 1.73 2004/06/24 16:48:59 leo Exp $
+$Id: perlhash.pmc,v 1.74 2004/06/25 10:19:52 leo Exp $
=head1 NAME
@@ -32,6 +32,44 @@
static void
fromkeys(Interp *interpreter, PMC *self, PMC *keys, PMC *value)
{
+ INTVAL elems, dod_disabled, i;
+ PMC *iter;
+
+ if (PMC_IS_NULL(value))
+ value = pmc_new(interpreter, enum_class_None);
+
+ /*
+ * if the number of keys is bigger then the current PMC
+ * count, we do one DOD run and then disable DOD/GC
+ */
+ dod_disabled = 0;
+ elems = 999999; /* TODO VTABLE_elements(interpreter, keys); */
+ if (elems > (INTVAL)interpreter->arena_base->pmc_pool->total_objects) {
+ Parrot_do_dod_run(interpreter, 0);
+ Parrot_block_DOD(interpreter);
+ Parrot_block_GC(interpreter);
+ dod_disabled = 1;
+ }
+ /*
+ * keys should be able to iterate
+ * TODO check that
+ */
+ if (keys->vtable->base_type == enum_class_Iterator ||
+ VTABLE_isa(interpreter, keys,
+ const_string(interpreter, "Iterator"))) {
+ iter = keys;
+ }
+ else
+ iter = pmc_new_init(interpreter, enum_class_Iterator, keys);
+ VTABLE_set_integer_native(interpreter, iter, ITERATE_FROM_START);
+ for (; VTABLE_get_bool(interpreter, iter); ) {
+ STRING *s = VTABLE_shift_string(interpreter, iter);
+ VTABLE_set_pmc_keyed_str(interpreter, self, s, value);
+ }
+ if (dod_disabled) {
+ Parrot_unblock_DOD(interpreter);
+ Parrot_unblock_GC(interpreter);
+ }
}
@@ -76,6 +114,10 @@
void class_init() {
/* class_init_code */
make_bufferlike_pool(INTERP, sizeof(struct _hash));
+ if (pass) {
+ enter_nci_method(INTERP, enum_class_PerlHash,
+ F2DPTR(fromkeys), "fromkeys", "vIOPP");
+ }
}
/*
1.7 +8 -2 parrot/classes/slice.pmc
Index: slice.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/slice.pmc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- slice.pmc 24 Jun 2004 16:48:59 -0000 1.6
+++ slice.pmc 25 Jun 2004 10:19:53 -0000 1.7
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: slice.pmc,v 1.6 2004/06/24 16:48:59 leo Exp $
+$Id: slice.pmc,v 1.7 2004/06/25 10:19:53 leo Exp $
=head1 NAME
@@ -54,7 +54,9 @@
*/
if (key_type(interpreter, range) & KEY_integer_FLAG) {
/* integer key */
- if (PObj_get_FLAGS(range) & KEY_inf_slice_FLAG) {
+ if ((PObj_get_FLAGS(range) &
+ (KEY_inf_slice_FLAG|KEY_end_slice_FLAG)) ==
+ (KEY_inf_slice_FLAG|KEY_end_slice_FLAG)) {
/*
* first range is ".. end"
* start at index 0
@@ -290,6 +292,10 @@
return VTABLE_get_integer(INTERP, key);
}
+ STRING* get_string_keyed(PMC* key) {
+ INTVAL v = VTABLE_get_integer(INTERP, key);
+ return string_from_int(INTERP, v);
+ }
/*
=item C<PMC* nextkey_keyed (PMC* agg, INTVAL what)>
1.35 +3 -0 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -w -r1.34 -r1.35
--- call_list.txt 22 Jun 2004 17:01:37 -0000 1.34
+++ call_list.txt 25 Jun 2004 10:19:58 -0000 1.35
@@ -193,6 +193,9 @@
v IOP
P Ii
+# PerlHash fromkeys
+v IOPP
+
# Oddball ones for postgres
p ptiLTLLi
p pi33ipi
1.20 +188 -2 parrot/t/pmc/iter.t
Index: iter.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/iter.t,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- iter.t 24 Jun 2004 16:49:04 -0000 1.19
+++ iter.t 25 Jun 2004 10:20:08 -0000 1.20
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: iter.t,v 1.19 2004/06/24 16:49:04 leo Exp $
+# $Id: iter.t,v 1.20 2004/06/25 10:20:08 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 31;
+use Parrot::Test tests => 37;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new iter");
@@ -676,6 +676,32 @@
ok
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "slice iter end range");
+ .include "iterator.pasm"
+ new P0, .PerlArray
+ push P0, 100
+ push P0, 200
+ push P0, 300
+ push P0, 400
+ push P0, 500
+ slice P2, P0[2 ..]
+ set P2, .ITERATE_FROM_START
+lp:
+ unless P2, ex
+ shift I0, P2
+ print I0
+ print "\n"
+ branch lp
+ex:
+ print "ok\n"
+ end
+CODE
+300
+400
+500
+ok
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "slice iter start range, value");
.include "iterator.pasm"
new P0, .PerlArray
@@ -1037,3 +1063,163 @@
3
ok
OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "hash fromkeys - string");
+##PIR##
+.sub main @MAIN
+ .include "iterator.pasm"
+ .local pmc hash
+ .local pmc value
+ .local pmc str
+ str = new PerlString
+ str = "abcdef"
+ hash = new PerlHash
+ null value
+ hash."fromkeys"(str, value)
+ $I0 = hash
+ print $I0
+ print " "
+ .local pmc iter
+ iter = new .Iterator, hash
+ iter = .ITERATE_FROM_START
+iter_loop:
+ unless iter, iter_end # while (entries) ...
+ $S0 = shift iter
+ print $S0
+ print ""
+ goto iter_loop
+iter_end:
+ print "ok\n"
+.end
+CODE
+/6 [abcdef]{6}ok/
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "hash fromkeys - array");
+##PIR##
+.sub main @MAIN
+ .include "iterator.pasm"
+ .local pmc hash
+ .local pmc value
+ .local pmc ar
+ ar = new PerlArray
+ push ar, "a"
+ push ar, "b"
+ push ar, "c"
+ push ar, "d"
+ push ar, "e"
+ hash = new PerlHash
+ null value
+ hash."fromkeys"(ar, value)
+ $I0 = hash
+ print $I0
+ print " "
+ .local pmc iter
+ iter = new .Iterator, hash
+ iter = .ITERATE_FROM_START
+iter_loop:
+ unless iter, iter_end # while (entries) ...
+ $S0 = shift iter
+ print $S0
+ goto iter_loop
+iter_end:
+ print "ok\n"
+.end
+
+CODE
+/5 [abcde]{5}ok/
+OUTPUT
+
+
+output_is(<<'CODE', <<'OUTPUT', "slice, get strings from array");
+##PIR##
+.sub main @MAIN
+ .include "iterator.pasm"
+ .local pmc ar
+ ar = new PerlArray
+ push ar, "a"
+ push ar, "b"
+ push ar, "c"
+ push ar, "d"
+ push ar, "e"
+ .local pmc iter
+ iter = slice ar[1 ..]
+ iter = .ITERATE_FROM_START
+iter_loop:
+ unless iter, iter_end # while (entries) ...
+ $S0 = shift iter
+ print $S0
+ goto iter_loop
+iter_end:
+ print "ok\n"
+.end
+CODE
+bcdeok
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "hash fromkeys - array slice");
+##PIR##
+.sub main @MAIN
+ .include "iterator.pasm"
+ .local pmc hash
+ .local pmc value
+ .local pmc ar
+ ar = new PerlArray
+ push ar, "a"
+ push ar, "b"
+ push ar, "c"
+ push ar, "d"
+ push ar, "e"
+ .local pmc sl
+ sl = slice ar[1 ..]
+ hash = new PerlHash
+ null value
+ hash."fromkeys"(sl, value)
+ $I0 = hash
+ print $I0
+ print " "
+ .local pmc iter
+ iter = new .Iterator, hash
+ iter = .ITERATE_FROM_START
+iter_loop:
+ unless iter, iter_end # while (entries) ...
+ $S0 = shift iter
+ print $S0
+ goto iter_loop
+iter_end:
+ print "ok\n"
+.end
+CODE
+/4 [bcde]{4}ok/
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "hash fromkeys - xrange");
+##PIR##
+.sub main @MAIN
+ .include "iterator.pasm"
+ .local pmc hash
+ .local pmc value
+ .local pmc xr
+ xr = new Slice
+ .local pmc sl
+ sl = slice xr[0 .. 10]
+ hash = new PerlHash
+ null value
+ hash."fromkeys"(sl, value)
+ $I0 = hash
+ print $I0
+ print " "
+ .local pmc iter
+ iter = new .Iterator, hash
+ iter = .ITERATE_FROM_START
+iter_loop:
+ unless iter, iter_end # while (entries) ...
+ $S0 = shift iter
+ print $S0
+ goto iter_loop
+iter_end:
+ print "ok\n"
+.end
+CODE
+/10 [0123456789]{10}ok/
+OUTPUT
