Permalink
Browse files

Implement get_pmc_keyed for P5Scalar

It's completely wrong in several ways, but it works, and I don't know
of a less wrong way to make it happen.
  • Loading branch information...
1 parent 90ed467 commit a39f261f12349f8ca16eed91529d564b2a555599 @sorear sorear committed Apr 9, 2010
Showing with 73 additions and 0 deletions.
  1. +12 −0 nt/keyed.t
  2. +61 −0 src/pmc/p5scalar.pmc
View
12 nt/keyed.t
@@ -0,0 +1,12 @@
+# vim: ft=perl6
+
+plan(3);
+
+my $p5code := '{ foo => 2, bar => 7 }';
+
+pir::load_bytecode("perl5.pir");
+my $p5obj := pir::compreg__ps("perl5").make_interp($p5code)();
+
+ok($p5obj<foo> == 2, "can access p5 hashes");
+ok($p5obj<bar> == 7, "different keys are distinct");
+ok(!pir::defined($p5obj<baz>), "failure is reported");
View
61 src/pmc/p5scalar.pmc
@@ -95,6 +95,67 @@ Returns the string value of the SV.
return Parrot_str_new(interp, perl5_str, strlen(perl5_str));
}
+ VTABLE PMC *get_pmc_keyed(PMC *key) {
+ PerlInterpreter *my_perl;
+ PMC *p5i, *elpmc;
+ SV *sv, *rsv, *element;
+ svtype type;
+ PMC *nextkey = key_next(interp, key);
+
+ GET_ATTR_p5i(interp, SELF, p5i);
+ GETATTR_P5Interpreter_my_perl(interp, p5i, my_perl);
+ GET_ATTR_sv(interp, SELF, sv);
+
+ SvGETMAGIC(sv);
+
+ if (!SvROK(sv))
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "non-reference value used as aggregate");
+
+ /* XXX handle overloading
+ problem: we don't necessarily know whether to use @{} or %{}
+ Austin suggests using whichever is overloaded, else @{} */
+ rsv = SvRV(sv);
+ type = SvTYPE(rsv);
+
+ if (type == SVt_PVHV) {
+ HE *hashent;
+ SV *svkey;
+ STRING *strkey = VTABLE_get_string(interp, key);
+ /* XXX this is wrong. UTF8, embedded nuls */
+ char *ckey = Parrot_str_to_cstring(interp, strkey);
+ ENTER;
+ SAVETMPS;
+ svkey = sv_2mortal(newSVpv(ckey, 0));
+ mem_sys_free(ckey);
+ hashent = hv_fetch_ent((HV*)rsv, svkey, 0, 0);
+ element = hashent ? SvREFCNT_inc(HeVAL(hashent)) : NULL;
+ FREETMPS;
+ LEAVE;
+ } else {
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "non-hash reference used as aggregate");
+ }
+
+ if (element)
+ elpmc = blizkost_wrap_sv(interp, p5i, element);
+ else
+ elpmc = PMCNULL;
+
+ SvREFCNT_dec(element);
+
+ if (nextkey) {
+ if (PMC_IS_NULL(elpmc))
+ elpmc = Parrot_pmc_new(interp, enum_class_Undef);
+ return VTABLE_get_pmc_keyed(interp, elpmc, nextkey);
+ } else {
+ return elpmc;
+ }
+ }
+
+
/*
=item C<PMC *find_method(STRING *name)>

0 comments on commit a39f261

Please sign in to comment.