[Jifty-commit] r5383 - in Runops-Hook/trunk: .

Jifty commits jifty-commit at lists.jifty.org
Wed May 7 10:51:22 EDT 2008


Author: nothingmuch
Date: Wed May  7 10:51:18 2008
New Revision: 5383

Added:
   Runops-Hook/trunk/t/07perl_Hook.t
Modified:
   Runops-Hook/trunk/Hook.xs

Log:
Add forgotten test, and fix aassign

Modified: Runops-Hook/trunk/Hook.xs
==============================================================================
--- Runops-Hook/trunk/Hook.xs	(original)
+++ Runops-Hook/trunk/Hook.xs	Wed May  7 10:51:18 2008
@@ -4,7 +4,7 @@
 #include "embed.h"
 #include "XSUB.h"
 
-#define XPUSHREF(x) XPUSHs(sv_2mortal(newRV(x)))
+#define XPUSHREF(x) XPUSHs(sv_2mortal(newRV_inc(x)))
 
 bool (*Runops_Hook_hook)(pTHX);
 
@@ -22,11 +22,12 @@
 static SV *Runops_Hook_fakeop_sv;
 
 enum Runops_Hook_OP_ARITY {
+	ARITY_UNKNOWN = 0,
 	ARITY_NULL,
 	ARITY_UNARY,
 	ARITY_BINARY,
 	ARITY_LIST,
-	ARITY_UNKNOWN
+	ARITY_LIST_BINARY,
 };
 
 /* this is the modified runloop */
@@ -123,7 +124,7 @@
 			switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
 				case OA_BINOP:
 					if ( o->op_type == OP_AASSIGN ) {
-						return ARITY_UNKNOWN;
+						return ARITY_LIST_BINARY;
 					} else {
 						return ARITY_BINARY;
 					}
@@ -160,8 +161,8 @@
 	switch ( Runops_Hook_op_arity(aTHX_ PL_op) ) {
 		case ARITY_LIST:
 			/* repeat stack from the op's mark to SP just before we started pushing */
-			for (list_mark = PL_stack_base + *(PL_markstack_ptr-1); list_mark < orig_sp;) {
-				XPUSHREF(*++list_mark);
+			for (list_mark = PL_stack_base + *(PL_markstack_ptr-1) + 1; list_mark <= orig_sp; list_mark++) {
+				XPUSHREF(*list_mark);
 			}
 
 			break;
@@ -172,10 +173,46 @@
 			XPUSHREF(*orig_sp);
 			break;
 
+		case ARITY_LIST_BINARY:
+			{
+				SV **mark = PL_stack_base + TOPMARK + 2; dORIGMARK;
+
+				printf("bin listop SP=%p, orig_sp=%p, topmark=%p, mark=%p\n", SP, orig_sp, TOPMARK, mark);
+
+				SV **lastlelem = orig_sp;
+				SV **lastrelem = PL_stack_base + *(PL_markstack_ptr-1);
+				SV **firstrelem = PL_stack_base + *(PL_markstack_ptr-2) + 1;
+				SV **firstlelem = lastrelem + 1;
+
+				printf("firstlelem=%p, lastlelem=%p, firstrelem=%p, lastrelem=%p\n", firstlelem, lastlelem, firstrelem, lastrelem);
+				printf("nlelem=%d nrelem=%d\n", (lastlelem - firstlelem) / sizeof(SV **) + 1, (lastrelem - firstrelem) + 1);
+
+				SV *lav = newAV();
+				SV *rav = newAV();
+
+				SV **i;
+
+				for (i = firstlelem; i <= lastlelem; i++) {
+					av_push(lav, newRV_inc(*i));
+				}
+
+				for (i = firstrelem; i <= lastrelem; i++) {
+					av_push(rav, newRV_inc(*i));
+				}
+
+
+				SP = ORIGMARK;
+
+				XPUSHREF(lav);
+				XPUSHREF(rav);
+			}
+
+			break;
+
 		case ARITY_NULL:
 			break;
 
-		case ARITY_UNKNOWN:
+		default:
 			warn("Unknown arity for %s (%p)", PL_op_name[PL_op->op_type], PL_op);
 			break;
 	}
@@ -248,7 +285,7 @@
 Runops_Hook_load_B (pTHX) {
 	if (!Runops_Hook_loaded_B) {
 		load_module( PERL_LOADMOD_NOIMPORT, newSVpvs("B"), newSViv(0) );
-		Runops_Hook_fakeop_sv = sv_bless(newRV(newSVuv((UV)&Runops_Hook_fakeop)), gv_stashpv("B::UNOP", 0));
+		Runops_Hook_fakeop_sv = sv_bless(newRV_noinc(newSVuv((UV)&Runops_Hook_fakeop)), gv_stashpv("B::UNOP", 0));
 		Runops_Hook_loaded_B = 1;
 	}
 }

Added: Runops-Hook/trunk/t/07perl_Hook.t
==============================================================================
--- (empty file)
+++ Runops-Hook/trunk/t/07perl_Hook.t	Wed May  7 10:51:18 2008
@@ -0,0 +1,85 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Runops::Hook;
+use Test::More 'no_plan';
+
+use Scalar::Util qw(refaddr);
+
+my ( $called, @ops, @refgen_args, @aassign_args );
+
+Runops::Hook::set_hook(sub {
+	my ( $hook, $op, @args ) = @_;
+
+	$called++;
+
+	if ( $op->name eq 'refgen' and @refgen_args < 2 ) {
+		push @refgen_args, [ @_[2 .. $#_] ];
+	} elsif ( $op->name eq 'aassign' ) {
+		push @aassign_args, [ @_[2 .. $#_] ];
+	}
+
+	push @ops, $_[1];
+});
+
+my $i;
+++$i;
+
+sub foo { sub { $i } };
+sub bar { sub { $i } };
+
+Runops::Hook::enable();
+
+++$i;
+my $j = $i + 42;
+
+my ( $x, @refs ) = \( 101, [qw/dancing hippies/], 33, \&foo );
+
+$i ? foo() : bar();
+
+if ( foo() || 1 ) {
+	$j = "" . $i;
+}
+
+Runops::Hook::disable();
+
+++$i;
+
+is( $i, 3, "ops dispatched" );
+ok( $called, "hook called" );
+ok( scalar(@ops), "cought some ops" );
+
+my %seen_names;
+foreach my $op ( @ops ) {
+	isa_ok( $op, "B::OP" );
+	$seen_names{$op->name}++;
+}
+
+foreach my $opname (qw(
+	nextstate
+	preinc add
+	entersub leavesub
+	refgen sassign aassign
+	padsv padav gv
+	cond_expr and or
+	const
+	anonlist
+	concat
+)) {
+	ok( $seen_names{$opname}, "$opname op seen by hook" );
+}
+
+is_deeply( \@refgen_args, [ [ \&foo ], [ $x, @refs ] ], "listop arg capture" );
+
+is( refaddr($refgen_args[1][0]), refaddr($x), "aliasing semantics" );
+
+is_deeply(
+	\@aassign_args,
+	[[
+		[ \$x, \@refs ],   # two lvalues
+		[ \$x, \(@refs) ], # four rvalues, passed to the hook by ref
+	]],
+	"aassign",
+);


More information about the Jifty-commit mailing list