[svn:parrot] r48347 - in branches/gsoc_instrument: examples/library t/dynpmc t/library
khairul at svn.parrot.org
khairul at svn.parrot.org
Sun Aug 8 16:36:50 UTC 2010
Author: khairul
Date: Sun Aug 8 16:36:50 2010
New Revision: 48347
URL: https://trac.parrot.org/parrot/changeset/48347
Log:
Updated tests.
Modified:
branches/gsoc_instrument/examples/library/tracer.nqp
branches/gsoc_instrument/t/dynpmc/instrumentclass.t (contents, props changed)
branches/gsoc_instrument/t/dynpmc/instrumentgc.t
branches/gsoc_instrument/t/dynpmc/instrumentobject.t (contents, props changed)
branches/gsoc_instrument/t/library/instrument_eventlibrary.t
Modified: branches/gsoc_instrument/examples/library/tracer.nqp
==============================================================================
--- branches/gsoc_instrument/examples/library/tracer.nqp Sun Aug 8 16:34:32 2010 (r48346)
+++ branches/gsoc_instrument/examples/library/tracer.nqp Sun Aug 8 16:36:50 2010 (r48347)
@@ -25,11 +25,13 @@
my @args := pir::getinterp__p()[2];
@args.shift();
-my $probe := Instrument::Probe.new();
+my $instr := pir::new__PS('Instrument');
+
+my $probe := $instr.instrument_op();
$probe.catchall(1);
$probe.callback('tracer');
-my $instr := pir::new__PS('Instrument');
+
$instr.attach($probe);
$instr.run(@args[0], @args);
Modified: branches/gsoc_instrument/t/dynpmc/instrumentclass.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrumentclass.t Sun Aug 8 16:34:32 2010 (r48346)
+++ branches/gsoc_instrument/t/dynpmc/instrumentclass.t Sun Aug 8 16:36:50 2010 (r48347)
@@ -27,12 +27,17 @@
# Load the Instrument library.
load_bytecode 'Instrument/InstrumentLib.pbc'
- plan(13)
+ plan(39)
setup()
+ test_creation()
+ test_attaching()
test_insertion()
test_removal()
- test_notification()
+ test_notification_vtable()
+ test_insertion()
+ test_removal()
+ test_notification_methods()
cleanup()
.return()
@@ -46,6 +51,7 @@
.sub main :main
$P0 = new ['TestClass']
$P0.'test'()
+ $I0 = isa $P0, 'TestClass'
.end
.namespace ['TestClass']
@@ -53,6 +59,11 @@
$P0 = newclass ['TestClass']
.end
+# Test override.
+.sub init :vtable :method
+ # Do nothing.
+.end
+
# Test methods.
.sub test :method
# Do nothing.
@@ -75,6 +86,170 @@
os.'rm'('t/dynpmc/instrumentclass-test1.pir')
.end
+.sub test_creation
+ # InstrumentClass is supposed to be instantiated with
+ # an Instrument instance.
+ # Check:
+ # 1. init throws an exception.
+ # 2. init_pmc initialises without any exception.
+ $P0 = new ['Instrument']
+
+ ## Scenario 1: Call init.
+
+ # Set up exception handler.
+ $P1 = new ['ExceptionHandler']
+ set_addr $P1, INIT_OK
+ push_eh $P1
+
+ $P2 = new ['InstrumentClass']
+
+ ok(0, 'Creation: Init did not throw exception.')
+
+ goto INIT_END
+
+ INIT_OK:
+ ok(1, 'Creation: Init threw exception.')
+ INIT_END:
+
+ ## Scenario 2: Call init_pmc.
+ $P3 = new ['InstrumentClass'], $P0
+ $I0 = isa $P3, 'InstrumentClass'
+ is($I0, 1, 'Creation: init_pmc successful.')
+.end
+
+.sub test_attaching
+ # Test attaching an InstrumentClass instance to a class.
+ # Check:
+ # 1. Attaching to an exisiting class is fine.
+ $P0 = new ['Instrument']
+
+ ## Scenario 1: Attach to an existing class (Sub)
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ ok(1, 'Attach: Existing class ok.')
+.end
+
+.sub test_insertion
+ # Test inserting a hook into the vtables of a class.
+ # Check:
+ # 1. Insert 1 hook and check that there is 1 hook in the hook list.
+ # 2. Insert 1 hook twice and check that there is only 1 entry in the hook list.
+ # 3. Insert 2 different hooks and check that there are 2 entries in the hook list.
+ # 4. Insert a hook group and check that the hook list matches that in the group.
+ # (Group is obtained by querying the get_hook_list method.)
+ $P0 = new ['Instrument']
+
+ ## Scenario 1: Insert 1 hook.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('init')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ $S0 = $P2[0]
+ is($I0, 1, 'Insert: 1: Count ok.')
+ is($S0, 'init', 'Insert: 1: Name ok.')
+
+ ## Scenario 2: Insert 1 hook twice.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('init')
+ $P1.'insert_hook'('init')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ $S0 = $P2[0]
+ is($I0, 1, 'Insert: 2: Count ok.')
+ is($S0, 'init', 'Insert: 2: Name ok.')
+
+ ## Scenario 3: Insert 2 different hooks.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('init')
+ $P1.'insert_hook'('init_pmc')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ $I1 = find_in_list($P2, 'init')
+ $I2 = find_in_list($P2, 'init_pmc')
+ $I3 = $I1 + $I2
+ is($I0, 2, 'Insert: 3: Count ok.')
+ is($I3, 2, 'Insert: 3: Name ok.')
+
+ ## Scenario 4: Insert a group of hooks.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('math')
+ $P2 = $P1.'get_instrumented_list'()
+ $P3 = $P1.'get_hook_list'('math')
+
+ $I0 = $P2
+ $I1 = $P3
+ $I2 = is_same_set($P2, $P3)
+ is($I0, $I1, 'Insert: 4: Count ok.')
+ is($I2, 1, 'Insert: 4: Group ok.')
+.end
+
+.sub test_removal
+ # Test removal of inserted hooks into the vtable of a class.
+ # Check:
+ # 1. Removal of an inserted hook.
+ # 2. A hook inserted twice and removed once will still be active.
+ # 3. Removing a group of hooks.
+ # 4. Removing a non-existent hook will throw an exception.
+ $P0 = new ['Instrument']
+
+ ## Scenario 1: Remove a single hook.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('init')
+ $P1.'remove_hook'('init')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ is($I0, 0, 'Remove: 1: Count ok.')
+
+ ## Scenario 2: Remove a hook inserted twice.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('init')
+ $P1.'insert_hook'('init')
+ $P1.'remove_hook'('init')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ $S0 = $P2[0]
+ is($I0, 1, 'Remove: 2: Count ok.')
+ is($S0, 'init', 'Remove: 2: Name ok.')
+
+ ## Scenario 3: Remove a group of hooks.
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'insert_hook'('math')
+ $P1.'remove_hook'('math')
+ $P2 = $P1.'get_instrumented_list'()
+
+ $I0 = $P2
+ is($I0, 0, 'Remove: 3: Count ok.')
+
+ ## Scenario 4: Remove a non-existent hook.
+ $P2 = new ['ExceptionHandler']
+ set_addr $P2, ATTACH_OK
+ push_eh $P2
+
+ $P1 = new ['InstrumentClass'], $P0
+ $P1.'attach_to_class'('Sub')
+ $P1.'remove_hook'('init')
+
+ ok(0, 'Remove: 4: Removing a non-existent hook did not throw exception.')
+
+ goto ATTACH_END
+
+ ATTACH_OK:
+ ok(1, 'Remove: 4: Removing a non-existent hook threw exception.')
+ ATTACH_END:
+.end
+
.sub test_insertion
# Test insertion a method hook.
# ResizablePMCArray has a push method.
@@ -85,6 +260,7 @@
## Scenario 1: Insert a method hook.
$P1 = $P0.'instrument_class'('ResizablePMCArray')
+ $P1 = getattribute $P1, '$!hook_obj'
$P1.'insert_method_hook'('push')
$P2 = $P1.'get_instrumented_method_list'()
@@ -119,6 +295,7 @@
# 4. Try to remove a non-existent hook throws exception.
$P0 = new ['Instrument']
$P1 = $P0.'instrument_class'('ResizablePMCArray')
+ $P1 = getattribute $P1, '$!hook_obj'
## Scenario 1: Insert once and remove once.
$P1.'insert_method_hook'('push')
@@ -177,17 +354,66 @@
NON_EXIST_END:
.end
-.sub test_notification
+.sub test_notification_vtable
+ # Test that notifications work, a class that is defined/loaded at runtime
+ # is instrumented and also vtable overrides work.
+ # In short, TestClass is only defined at runtime, has vtable overrides,
+ # and this tests all of it.
+ # Uses Instrument::Event::Class.
+ # Check:
+ # 1. The event is raised.
+ $P0 = new ['Instrument']
+ $P2 = $P0.'instrument_class'('TestClass')
+ $P2.'inspect_vtable'('init')
+ $P2.'callback'('test_notification_cb')
+
+ $P0.'attach'($P2)
+
+ # Set the arg list.
+ $S0 = 't/dynpmc/instrumentvtable-test1.pir'
+ $P3 = new ['ResizableStringArray']
+ push $P3, $S0
+
+ # Prepare the globals.
+ $P4 = new ['Hash']
+ set_global '%notification', $P4
+
+ $P0.'run'($S0, $P3)
+
+ # Check that the callback was called.
+ # Check that the event was fired.
+ $P9 = get_global '%notification'
+
+ # Event fired.
+ $I0 = $P9['called']
+ is($I0, 1, 'Vtable: Event fired.')
+
+ # Test line.
+ $I0 = $P9['line']
+ is($I0, 2, 'Vtable: Line ok.')
+
+ # Test file.
+ $S0 = $P9['file']
+ is($S0, 't/dynpmc/instrumentvtable-test1.pir', 'Vtable: File ok.')
+
+ # Test sub.
+ $S0 = $P9['sub']
+ is($S0, 'main', 'Vtable: Sub ok.')
+
+ # Test event.
+ $P10 = $P9['event']
+ $S0 = join '::', $P10
+ is($S0, 'Class::TestClass::vtable::main::init', 'Vtable: Event ok')
+.end
+
+.sub test_notification_methods
# Test if notification is raised after a method is instrumented.
# Check:
# 1. Event is raised.
# 2. The event is of type Class::Class_Name::method::Method_Name
$P0 = new ['Instrument']
- $P1 = get_hll_global ['Instrument';'Event'], 'Class'
- $P2 = $P1.'new'()
-
- $P2.'inspect_class'('TestClass')
+ $P2 = $P0.'instrument_class'('TestClass')
$P2.'inspect_method'('test')
$P2.'callback'('test_notification_cb')
@@ -209,24 +435,24 @@
# Event fired.
$I0 = $P9['called']
- is($I0, 1, 'Event: Event fired.')
+ is($I0, 1, 'Method: Event fired.')
# Test line.
$I0 = $P9['line']
- is($I0, 3, 'Event: Line ok.')
+ is($I0, 3, 'Method: Line ok.')
# Test file.
$S0 = $P9['file']
- is($S0, 't/dynpmc/instrumentclass-test1.pir', 'Event: File ok.')
+ is($S0, 't/dynpmc/instrumentclass-test1.pir', 'Method: File ok.')
# Test sub.
$S0 = $P9['sub']
- is($S0, 'main', 'Event: Sub ok.')
+ is($S0, 'main', 'Method: Sub ok.')
# Test event.
$P10 = $P9['event']
$S0 = join '::', $P10
- is($S0, 'Class::TestClass::method::test', 'Event: Event ok')
+ is($S0, 'Class::TestClass::method::test', 'Method: Event ok')
.end
Modified: branches/gsoc_instrument/t/dynpmc/instrumentgc.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrumentgc.t Sun Aug 8 16:34:32 2010 (r48346)
+++ branches/gsoc_instrument/t/dynpmc/instrumentgc.t Sun Aug 8 16:36:50 2010 (r48347)
@@ -318,15 +318,14 @@
.end
.sub test_sample_notification
- .local pmc instr, gc_event, args, gc_class
+ .local pmc instr, gc_event, args
$S0 = 't/dynpmc/instrumentgc-test1.pir'
args = new ['ResizableStringArray']
push args, $S0
- gc_class = get_hll_global ['Instrument';'Event'], 'GC'
- gc_event = gc_class.'new'()
instr = new ['Instrument']
+ gc_event = instr.'instrument_gc'()
# Set up the globals.
$P0 = new ['Hash']
Modified: branches/gsoc_instrument/t/dynpmc/instrumentobject.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrumentobject.t Sun Aug 8 16:34:32 2010 (r48346)
+++ branches/gsoc_instrument/t/dynpmc/instrumentobject.t Sun Aug 8 16:36:50 2010 (r48347)
@@ -27,7 +27,7 @@
# Load the Instrument library.
load_bytecode 'Instrument/InstrumentLib.pbc'
- plan(6)
+ plan(8)
setup()
test_notification()
@@ -42,22 +42,35 @@
.local string program
program = <<'PROG'
.sub main :main
- $P0 = new ['TestClass'] # To instrument.
- $P1 = new ['TestClass'] # Control, not instrumented
- $P0.'test'()
- $P1.'test'()
+ $P0 = new ['TestClass'] # To instrument.
+ $P1 = new ['TestClass'] # Control, not instrumented.
+ $P2 = new ['TestClass2'] # Test inheritance.
+
+ $P0.'test'(10)
+ $P1.'test'(20)
+ $P2.'test'(30)
+
+ $P0 = 100
+ $P1 = 200
+ $P2 = 300
.end
.namespace ['TestClass']
.sub '' :anon :init :load
- $P0 = newclass ['TestClass']
+ $P0 = subclass ['Integer'], ['TestClass']
.end
# Test methods.
.sub test :method
+ .param int foo
# Do nothing.
.end
+.namespace ['TestClass2']
+.sub '' :anon :init :load
+ $P0 = subclass ['TestClass'], ['TestClass2']
+.end
+
PROG
# Write to file.
@@ -81,6 +94,8 @@
# 1. Event is raised.
# 2. The event is of type Object::address::method::Method_Name
# 3. The class event still fires.
+ # 4. When a subclass's instance invokes parent's method, it also fires.
+ # 5. Vtable instrumentation on the object only applies to the object itself.
$P0 = new ['Instrument']
$P2 = $P0.'instrument_op'()
@@ -88,10 +103,7 @@
$P2.'callback'('test_notification_probe_cb')
$P0.'attach'($P2)
- $P4 = get_hll_global ['Instrument';'Event'], 'Class'
- $P5 = $P4.'new'()
-
- $P5.'inspect_class'('TestClass')
+ $P5 = $P0.'instrument_class'('TestClass')
$P5.'inspect_method'('test')
$P5.'callback'('test_notification_class_cb')
$P0.'attach'($P5)
@@ -103,8 +115,10 @@
# Prepare the globals.
$P6 = new ['Hash']
set_global '%notification', $P6
- $P7 = box 0
- set_global '$class_event', $P7
+ $P7 = new ['Hash']
+ set_global '%class_event', $P7
+ $P8 = box 0
+ set_global '$object_vtable', $P8
$P0.'run'($S0, $P3)
@@ -118,7 +132,7 @@
# Test line.
$I0 = $P9['line']
- is($I0, 4, 'Event: Line ok.')
+ is($I0, 6, 'Event: Line ok.')
# Test file.
$S0 = $P9['file']
@@ -141,14 +155,30 @@
is($S0, $S1, 'Event: Event ok')
# Check that the class event still fires.
- $P12 = get_global '$class_event'
- $I0 = $P12
- is($I0, 1, 'Event: Class event still fires.')
+ $P12 = get_global '%class_event'
+ $I0 = $P12['TestClass']
+ is($I0, 2, 'Event: Class method event for TestClass fires as expected.')
+ $I0 = $P12['TestClass2']
+ is($I0, 1, 'Event: Class method event for TestClass2 fires as expected.')
+
+ # Check that the vtable event is only called once.
+ $P12 = get_global '$object_vtable'
+ $I0 = $P12
+ is($I0, 1, 'Event: Vtable event for object fires as expected.')
.end
.sub test_notification_class_cb
- $P0 = get_global '$class_event'
- $P0 = 1
+ .param pmc data
+ .param pmc instr
+ .param pmc probe
+
+ $P1 = data['invocant']
+ $S0 = typeof $P1
+
+ $P0 = get_global '%class_event'
+ $I0 = $P0[$S0]
+ inc $I0
+ $P0[$S0] = $I0
.end
.sub test_notification_probe_cb
@@ -189,6 +219,11 @@
$P1.'callback'('test_notification_cb')
instr.'attach'($P1)
+ $P2 = instr.'instrument_object'($P0)
+ $P2.'inspect_vtable'('set_integer_native')
+ $P2.'callback'('test_vtable_notification_cb')
+ instr.'attach'($P2)
+
# Build up the event string.
$P2 = new ['ResizableStringArray']
$S0 = $P1.'get_address'()
@@ -224,74 +259,9 @@
$P0['sub'] = $S0
.end
-
-## Helper: Find an item in the list.
-.sub find_in_list
- .param pmc list
- .param pmc item
-
- $I0 = list
-
- TOP:
- dec $I0
- unless $I0 >= 0 goto END
-
- $P0 = list[$I0]
- if $P0 == item goto FOUND
-
- goto TOP
- END:
-
- # Not found.
- .return(0)
-
- FOUND:
- .return(1)
-.end
-
-# Helper sub: Check if 2 sets with unique items are the same.
-.sub is_same_set
- .param pmc arr1
- .param pmc arr2
- .local pmc hash
-
- $I0 = arr1
- $I1 = arr2
- if $I0 != $I1 goto NO
-
- hash = new ['Hash']
-
- # Build the comparison hash
- $I3 = 0
- INSERT_LOOP:
- if $I3 >= $I0 goto END_INSERT_LOOP
-
- $S0 = arr1[$I3]
- hash[$S0] = 1
-
- inc $I3
- goto INSERT_LOOP
- END_INSERT_LOOP:
-
- # Check the contents of arr2
- $I3 = 0
- CHECK_LOOP:
- if $I3 >= $I0 goto END_CHECK_LOOP
-
- $S0 = arr2[$I3]
- $I4 = exists hash[$S0]
-
- if $I4 == 0 goto NO
-
- inc $I3
- goto CHECK_LOOP
- END_CHECK_LOOP:
-
- YES:
- .return(1)
-
- NO:
- .return(0)
+.sub test_vtable_notification_cb
+ $P0 = get_global '$object_vtable'
+ inc $P0
.end
# Local Variables:
Modified: branches/gsoc_instrument/t/library/instrument_eventlibrary.t
==============================================================================
--- branches/gsoc_instrument/t/library/instrument_eventlibrary.t Sun Aug 8 16:34:32 2010 (r48346)
+++ branches/gsoc_instrument/t/library/instrument_eventlibrary.t Sun Aug 8 16:36:50 2010 (r48347)
@@ -30,7 +30,7 @@
# Load the Instrument library.
load_bytecode 'Instrument/InstrumentLib.pbc'
- plan(9)
+ plan(10)
test_loadlib()
test_gc()
@@ -39,7 +39,7 @@
.end
.sub test_loadlib
- .local pmc fh, os, event, instr, args
+ .local pmc fh, os, event, instr, args, spec
.local string program1, program2
# Dynlib loading has 4 scenarios.
@@ -79,6 +79,8 @@
# Run the test.
$P0 = new ['Hash']
set_global '%test_loadlib_res', $P0
+ $P0 = new ['String']
+ set_global '$test_loadlib_specific', $P0
args = new ['ResizableStringArray']
push args, 't/library/instrument_eventlibrary-loadlib-2.pir'
@@ -86,8 +88,13 @@
event = $P1.'new'()
event.'callback'('test_loadlib_callback')
+ spec = $P1.'new'()
+ spec.'inspect'('file')
+ spec.'callback'('test_loadlib_specific_cb')
+
instr = new ['Instrument']
instr.'attach'(event)
+ instr.'attach'(spec)
instr.'run'('t/library/instrument_eventlibrary-loadlib-1.pir', args)
# Check the result.
@@ -104,6 +111,10 @@
$I0 = $P0['file']
is($I0, 1, 'Loadlib: Scenario 4 ok.')
+ $P0 = get_global '$test_loadlib_specific'
+ $S0 = $P0
+ is($S0, 'file', 'Loadlib: Specific library ok.')
+
# Cleanup.
os = new ['OS']
os.'rm'('t/library/instrument_eventlibrary-loadlib-1.pir')
@@ -121,6 +132,16 @@
$P0[$S0] = 1
.end
+.sub test_loadlib_specific_cb
+ .param pmc data
+ .param pmc instr
+ .param pmc probe
+
+ $P0 = get_global '$test_loadlib_specific'
+ $P0 = data['library']
+ set_global '$test_loadlib_specific', $P0
+.end
+
.sub test_gc
.local pmc fh, os, instr, args
.local string program
@@ -162,20 +183,19 @@
instr = new ['Instrument']
# Scenario 1.
- $P1 = get_hll_global ['Instrument';'Event'], 'GC'
- $P2 = $P1.'new'()
+ $P2 = instr.'instrument_gc'()
$P2.'callback'('test_gc_scenario_1')
$P2.'inspect'('do_gc_mark')
instr.'attach'($P2)
# Scenario 2.
- $P3 = $P1.'new'()
+ $P3 = instr.'instrument_gc'()
$P3.'callback'('test_gc_scenario_2')
$P3.'inspect'('allocate')
instr.'attach'($P3)
# Scenario 3.
- $P4 = $P1.'new'()
+ $P4 = instr.'instrument_gc'()
$P4.'callback'('test_gc_scenario_3')
$P4.'inspect'('free')
instr.'attach'($P4)
More information about the parrot-commits
mailing list