diff --git a/build/Makefile.in b/build/Makefile.in index 3db77fb..41d02f2 100644 --- a/build/Makefile.in +++ b/build/Makefile.in @@ -75,7 +75,8 @@ PMC_SOURCES = \ src/pmc/p5scalar.pmc \ src/pmc/p5hashiter.pmc \ src/pmc/p5namespace.pmc \ - src/pmc/p5invocation.pmc + src/pmc/p5invocation.pmc \ + src/pmc/p5hashiterresult.pmc PMC_C = $(PMC_SOURCES:.pmc=.c) PMC_DUMP = $(PMC_SOURCES:.pmc=.dump) diff --git a/nt/iterator.t b/nt/iterator.t index 9d3a61f..c97952d 100644 --- a/nt/iterator.t +++ b/nt/iterator.t @@ -1,6 +1,6 @@ # vim: ft=perl6 -plan(9); +plan(15); my $p5code := '{ foo => 2, bar => 7 }'; @@ -9,19 +9,36 @@ my $p5obj := pir::compreg__ps("perl5").make_interp($p5code)(); my %expected; my $got; +my $iter; + +$iter := pir::iter__pp($p5obj); +$got := pir::shift__pp($iter); +if $got.key eq 'foo' { + $got := pir::shift__pp($iter); +} + +ok((~$got.key) eq 'bar', "iterator results have keys accessible on .key"); +ok((~$got) eq 'bar', "iterator results stringify to keys"); +ok((+$got.value) == 7, "iterator values are accessible on .value"); +ok((~pir::deref__PP($got)) eq 'bar', "iterator keys are on get_pmc"); + +pir::shift__pp(pir::iter__pp($p5obj)); + +ok((~$got.key) eq 'bar', "pair keys remain accessible after a new iteration"); +ok((+$got.value) == 7, "pair values remain accessible after a new iteration"); %expected := 1; %expected := 1; -my $iter := pir::iter__pp($p5obj); +$iter := pir::iter__pp($p5obj); ok(?$iter, "iterator reports more elements [0/2]"); -$got := pir::shift__pp($iter); +$got := ~pir::shift__pp($iter); ok(%expected{$got}, "got foo or bar [0/2]"); %expected{$got} := 0; ok(?$iter, "iterator reports more elements [1/2]"); -$got := pir::shift__pp($iter); +$got := ~pir::shift__pp($iter); ok(%expected{$got}, "got the other [1/2]"); %expected{$got} := 0; @@ -39,11 +56,11 @@ ok(!?$iter, "iterator reports no more elements [2/2]"); $iter := pir::iter__pp($p5obj); -$got := pir::shift__pp($iter); +$got := ~pir::shift__pp($iter); ok(%expected{$got}, "got foo or bar without priming [0/2]"); %expected{$got} := 0; -$got := pir::shift__pp($iter); +$got := ~pir::shift__pp($iter); ok(%expected{$got}, "got the other without priming [1/2]"); %expected{$got} := 0; diff --git a/src/pmc/blizkost.h b/src/pmc/blizkost.h index afed4a6..49768ec 100644 --- a/src/pmc/blizkost.h +++ b/src/pmc/blizkost.h @@ -61,6 +61,7 @@ does the necessary cruft to import both in the same file. #include "pmc_p5sv.h" #include "pmc_p5scalar.h" #include "pmc_p5hashiter.h" +#include "pmc_p5hashiterresult.h" extern HE blizkost_EMPTY; diff --git a/src/pmc/p5hashiter.pmc b/src/pmc/p5hashiter.pmc index 1a4c9f4..1db3bee 100644 --- a/src/pmc/p5hashiter.pmc +++ b/src/pmc/p5hashiter.pmc @@ -77,8 +77,8 @@ Mark GC-ables. VTABLE PMC *shift_pmc() { HE *current_he = force_current_he(INTERP, SELF); - SV *keysv; - PMC *p5i, *hash; + SV *hashsv; + PMC *p5i, *hash, *tmppmc, *retpmc; PerlInterpreter *my_perl; if (current_he == NULL) { @@ -90,10 +90,19 @@ Mark GC-ables. GET_ATTR_backing_hash(INTERP, SELF, hash); GETATTR_P5SV_p5i(INTERP, hash, p5i); + GETATTR_P5SV_sv(INTERP, hash, hashsv); GETATTR_P5Interpreter_my_perl(INTERP, p5i, my_perl); - keysv = hv_iterkeysv(current_he); + retpmc = Parrot_pmc_new_noinit(interp, pmc_type(interp, + string_from_literal(interp, "P5HashIterResult"))); + PObj_custom_mark_SET(retpmc); - return blizkost_wrap_sv(INTERP, p5i, keysv); + SETATTR_P5HashIterResult_hekey(INTERP, retpmc, + blizkost_wrap_sv(INTERP, p5i, hv_iterkeysv(current_he))); + SETATTR_P5HashIterResult_hevalue(INTERP, retpmc, + blizkost_wrap_sv(INTERP, p5i, + hv_iterval((HV*)hashsv, current_he))); + + return retpmc; } } diff --git a/src/pmc/p5hashiterresult.pmc b/src/pmc/p5hashiterresult.pmc new file mode 100644 index 0000000..31fa85d --- /dev/null +++ b/src/pmc/p5hashiterresult.pmc @@ -0,0 +1,58 @@ +/* +Copyright (C) 2009, Jonathan Worthington and friends + +This file is distributed under the same terms as Parrot itself; see the +file LICENSE in the source root for details. + +=head1 NAME + +src/pmc/p5hashiterresult.pmc - Perl 5 hash entry + +=head1 DESCRIPTION + +This module provides a pair for p5hashiter to return. + +=cut + +*/ + +#include "blizkost.h" + +pmclass P5HashIterResult no_ro group blizkost_group dynpmc auto_attrs { + ATTR PMC *hekey; + ATTR PMC *hevalue; + + VTABLE void init() { + Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, + "Attempt to directly instantiate a P5HashIterResult"); + } + + VTABLE void mark() { + PMC *key; + PMC *value; + GET_ATTR_hekey(interp, SELF, key); + GET_ATTR_hevalue(interp, SELF, value); + if (key) + Parrot_gc_mark_PObj_alive(interp, (PObj*)key); + if (value) + Parrot_gc_mark_PObj_alive(interp, (PObj*)value); + } + + VTABLE PMC *get_pmc() { + return PARROT_P5HASHITERRESULT(SELF)->hekey; + } + + METHOD key() { + PMC *ret = PARROT_P5HASHITERRESULT(SELF)->hekey; + RETURN(PMC *ret); + } + + METHOD value() { + PMC *ret = PARROT_P5HASHITERRESULT(SELF)->hevalue; + RETURN(PMC *ret); + } + + VTABLE STRING* get_string() { + return VTABLE_get_string(INTERP, PARROT_P5HASHITERRESULT(SELF)->hekey); + } +}