[svn:parrot] r48108 - in branches/gsoc_instrument: runtime/parrot/library/Instrument src/dynpmc t/library
khairul at svn.parrot.org
khairul at svn.parrot.org
Mon Jul 19 06:49:35 UTC 2010
Author: khairul
Date: Mon Jul 19 06:49:34 2010
New Revision: 48108
URL: https://trac.parrot.org/parrot/changeset/48108
Log:
Added test for gc event class.
Modified:
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
branches/gsoc_instrument/src/dynpmc/instrumentstubbase.pmc
branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc
branches/gsoc_instrument/t/library/instrument_eventlibrary.t
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Mon Jul 19 02:29:59 2010 (r48107)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Mon Jul 19 06:49:34 2010 (r48108)
@@ -145,12 +145,16 @@
};
# Incomplete.
+# Inspect VTABLE.
+# Inspect methods.
+# Must handle dynloaded libraries.
class Instrument::Event::Class is Instrument::Event {
has @!class_names;
has @!vtable_probes;
has @!method_probes;
our @todo;
our $loadlib_event;
+ our $loadbytecode_event;
method _self_init() {
@!class_names := ();
@@ -203,8 +207,9 @@
CATCH {
# Something was not found.
- # Push to todo list.
- say("OH NOES! Class not found.");
+ # Push this probe to the todo list.
+ @Instrument::Event::Class::todo.push(self);
+ setup_load_event($!instr_obj);
}
}
@@ -212,7 +217,73 @@
};
method disable() {
+ if !$!is_enabled { return; }
+
+ my $dispatcher := Q:PIR {
+ $P0 = getattribute self, '$!instr_obj'
+ %r = $P0['eventdispatcher']
+ };
+
+ for (@!class_names) {
+ my $class_name := $_;
+ my $class := $!instr_obj.instrument_class($class_name);
+ my $event_prefix := 'Class::' ~ $class_name ~ '::';
+
+ # Register the vtable probes.
+ my $vtable_prefix := $event_prefix ~ 'vtable::';
+ for @!vtable_probes {
+ my @hooks := $class.get_hook_list($_);
+
+ for @hooks {
+ $class.remove_hook($_);
+ my $group := ($class.get_hook_group($_)).shift();
+
+ my $event := $vtable_prefix ~ $group ~ '::' ~ $_;
+ $dispatcher.deregister($event, $!callback);
+ }
+ }
+
+ CATCH {
+ # Ignore the exception.
+ # We are trying to disable a hook that wasn't inserted.
+ # TODO: Ensure that the exception came from a place that we are expecting.
+ # Otherwise rethrow. (How to do that in NQP?)
+ }
+ }
+
+ $!is_enabled := 0;
+ };
+
+ sub setup_load_event($instrument) {
+ if !pir::defined__IP($Instrument::Event::Class::loadlib_event) {
+ # Get the callback.
+ my $callback := pir::get_global__PS("load_cb");
+
+ # Define the loadlib event for this class.
+ my $loadlib := Instrument::Event::Internal::loadlib.new();
+ $loadlib.callback($callback);
+ $instrument.attach($loadlib);
+ $Instrument::Event::Class::loadlib_event := $loadlib;
+
+ # Define the load_bytecode event for this class.
+ my $bytecode := Instrument::Probe.new();
+ $bytecode.inspect('load_bytecode');
+ $bytecode.callback($callback);
+ $instrument.attach($bytecode);
+ $Instrument::Event::Class::loadbytecode_event := $bytecode;
+ }
};
+
+ sub load_cb($arg1?, $arg2?, $arg3?) {
+ say('Load event!');
+ my @list := @Instrument::Event::Class::todo;
+ @Instrument::Event::Class::todo := ();
+
+ for @list {
+ $_.disable();
+ $_.enable();
+ }
+ }
};
# vim: ft=perl6 expandtab shiftwidth=4:
Modified: branches/gsoc_instrument/src/dynpmc/instrumentstubbase.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrumentstubbase.pmc Mon Jul 19 02:29:59 2010 (r48107)
+++ branches/gsoc_instrument/src/dynpmc/instrumentstubbase.pmc Mon Jul 19 06:49:34 2010 (r48108)
@@ -247,6 +247,9 @@
list = Parrot_pmc_new(INTERP, enum_class_ResizableStringArray);
VTABLE_push_string(INTERP, list, name);
}
+ else {
+ list = VTABLE_clone(INTERP, list);
+ }
RETURN(PMC *list);
}
@@ -273,6 +276,7 @@
"%Ss : b Unknown function, '%Ss'",
VTABLE_name(INTERP, SELF), name);
}
+ groups = VTABLE_clone(INTERP, groups);
RETURN(PMC *groups);
}
Modified: branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc Mon Jul 19 02:29:59 2010 (r48107)
+++ branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc Mon Jul 19 06:49:34 2010 (r48108)
@@ -108,7 +108,6 @@
/* Find the class. */
attr->class_index = Parrot_pmc_get_type_str(supervised, classname);
- attr->original_struct = supervised->vtables[attr->class_index];
/* class_index must not be 0. (0 = default). */
if (attr->class_index == 0) {
@@ -116,6 +115,7 @@
"%Ss : Class not found, '%Ss'",
VTABLE_name(INTERP, SELF), classname);
}
+ attr->original_struct = supervised->vtables[attr->class_index];
/* Prepare the class's vtable for instrumentation. */
attr->instrumented_struct = mem_gc_allocate_zeroed_typed(supervised, _vtable);
Modified: branches/gsoc_instrument/t/library/instrument_eventlibrary.t
==============================================================================
--- branches/gsoc_instrument/t/library/instrument_eventlibrary.t Mon Jul 19 02:29:59 2010 (r48107)
+++ branches/gsoc_instrument/t/library/instrument_eventlibrary.t Mon Jul 19 06:49:34 2010 (r48108)
@@ -33,6 +33,7 @@
plan(4)
test_loadlib()
+ test_gc()
.return()
.end
@@ -118,6 +119,131 @@
$P0[$S0] = 1
.end
+.sub test_gc
+ .local pmc fh, os, instr, args
+ .local string program
+
+ # Test Instrument::Event::GC
+ # 1. Test instrumenting a single function ('do_gc_mark')
+ # 2. Test instrumenting by groups ('allocate')
+ # 3. Test disabling to ensure it works and the callback is not called.
+
+ ##
+ # PIR program files to test gc.
+ ##
+ program = <<'PROG1'
+.sub main :main
+ # Test allocation.
+ $P0 = new ['String']
+ $P0 = "this is a string"
+ $S0 = $P0
+
+ $P0 = new ['Undef']
+
+ # Test single function.
+ sweep 1
+ collect
+.end
+PROG1
+
+ fh = new ['FileHandle']
+ fh.'open'('t/library/instrument_eventlibrary-gc.pir', 'w')
+ fh.'puts'(program)
+ fh.'close'()
+
+
+ # Setup the test.
+ $P0 = new ['Hash']
+ $P0['Sc 2: Function Ok?'] = 1
+ set_global '%test_gc_res', $P0
+ args = new ['ResizableStringArray']
+
+ instr = new ['Instrument']
+
+ # Scenario 1.
+ $P1 = get_hll_global ['Instrument';'Event'], 'GC'
+ $P2 = $P1.'new'()
+ $P2.'callback'('test_gc_scenario_1')
+ $P2.'inspect'('do_gc_mark')
+ instr.'attach'($P2)
+
+ # Scenario 2.
+ $P3 = $P1.'new'()
+ $P3.'callback'('test_gc_scenario_2')
+ $P3.'inspect'('allocate')
+ instr.'attach'($P3)
+
+ # Scenario 3.
+ $P4 = $P1.'new'()
+ $P4.'callback'('test_gc_scenario_3')
+ $P4.'inspect'('free')
+ instr.'attach'($P4)
+ $P4.'disable'()
+
+ # Run the test.
+ instr.'run'('t/library/instrument_eventlibrary-gc.pir', args)
+
+ # Check the result.
+ $P5 = get_global '%test_gc_res'
+
+ # Scenario 1.
+ $I0 = $P5['Sc 1: Called']
+ $S0 = $P5['Sc 1: Function']
+ is($I0, 1, 'GC: Singular called')
+ is($S0, "do_gc_mark", 'GC: Singular name')
+
+ # Scenario 2.
+ $I0 = $P5['Sc 2: Called']
+ $I1 = $P5['Sc 2: Function Ok?']
+ is($I0, 1, 'GC: Group called')
+ is($I1, 1, 'GC: Group all belongs to allocate.')
+
+ # Scenario 3.
+ $I0 = $P5['Sc 3: Called']
+ is($I0, 0, 'GC: Disabled callback not called.')
+
+ # Cleanup.
+ os = new ['OS']
+ os.'rm'('t/library/instrument_eventlibrary-gc.pir')
+.end
+
+.sub test_gc_scenario_1
+ .param pmc data
+
+ # Test that a singular function was instrumented.
+ # Record the function name.
+ $P0 = get_global '%test_gc_res'
+ $S0 = data['type']
+ $P0['Sc 1: Called'] = 1
+ $P0['Sc 1: Function'] = $S0
+.end
+
+.sub test_gc_scenario_2
+ .param pmc data
+
+ # Test that a group function was instrumented.
+ # Ensure that the function is of type allocate.
+ $P0 = get_global '%test_gc_res'
+ $S0 = data['type']
+ $P1 = split '_', $S0
+ $S1 = $P1[0]
+ $I1 = iseq $S1, 'allocate'
+ $I2 = $P0['Sc 2: Function Ok?']
+ $I3 = and $I1, $I2
+
+ $P0['Sc 2: Called'] = 1
+ $P0['Sc 2: Function Ok?'] = $I3
+.end
+
+.sub test_gc_scenario_3
+ .param pmc data
+
+ # Since the probe was disabled, this should not be called.
+ $P0 = get_global '%test_gc_res'
+ $S0 = data['type']
+ $P0['Sc 1: Called'] = 1
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
More information about the parrot-commits
mailing list