[svn:parrot] r47783 - in branches/gsoc_instrument: . examples/library runtime/parrot/library/Instrument src/dynpmc t/dynpmc t/library
khairul at svn.parrot.org
khairul at svn.parrot.org
Wed Jun 23 13:01:32 UTC 2010
Author: khairul
Date: Wed Jun 23 13:01:31 2010
New Revision: 47783
URL: https://trac.parrot.org/parrot/changeset/47783
Log:
Added test for Probe class + interface updates.
Added:
branches/gsoc_instrument/t/library/instrument_probe.t (contents, props changed)
Modified:
branches/gsoc_instrument/MANIFEST
branches/gsoc_instrument/examples/library/tracer.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/Base.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
branches/gsoc_instrument/src/dynpmc/instrument.pmc
branches/gsoc_instrument/t/dynpmc/instrumentop.t (contents, props changed)
Modified: branches/gsoc_instrument/MANIFEST
==============================================================================
--- branches/gsoc_instrument/MANIFEST Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/MANIFEST Wed Jun 23 13:01:31 2010 (r47783)
@@ -1682,6 +1682,7 @@
t/dynpmc/foo2.t [test]
t/dynpmc/gziphandle.t [test]
t/dynpmc/instrument.t [test]
+t/dynpmc/instrumentop.t [test]
t/dynpmc/os.t [test]
t/dynpmc/pccmethod_test.t [test]
t/dynpmc/rational.t [test]
@@ -1712,6 +1713,7 @@
t/library/dumper.t [test]
t/library/getopt_obj.t [test]
t/library/hllmacros.t [test]
+t/library/instrument_probe.t [test]
t/library/iter.t [test]
t/library/lwp.t [test]
t/library/md5.t [test]
Modified: branches/gsoc_instrument/examples/library/tracer.nqp
==============================================================================
--- branches/gsoc_instrument/examples/library/tracer.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/examples/library/tracer.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -24,8 +24,8 @@
$args.shift();
my $probe := Instrument::Probe.new();
-$probe.make_catchall();
-$probe.set_callback('tracer');
+$probe.catchall(1);
+$probe.callback('tracer');
my $instr := Q:PIR { %r = new ['Instrument'] };
$instr.attach($probe);
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Base.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Base.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Base.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -73,48 +73,60 @@
=begin
-=item set_callback(sub) or set_callback('sub')
+=item callback(sub) or callback('sub') or callback()
Set the sub callback to be called when the desired op is
encountered. sub can be passed by name or reference through a
-Sub PMC object.
+Sub PMC object. Returns the current registered callback.
=cut
=end
- method set_callback ($sub) {
- $!callback := get_sub_obj($sub);
+ method callback ($sub?) {
+ if pir::defined__IP($sub) {
+ $!callback := get_sub_obj($sub);
+ }
+ return $!callback;
};
=begin
-=item set_finalize(sub) or set_finalize('sub')
+=item finalize(sub) or finalize('sub') or finalize()
Set the sub callback to be called at the end of execution.
sub can be passed by name or reference through a Sub PMC object.
Sub will only be called if the probe is enabled at the end of execution.
+Returns the registered finalize sub.
+
=cut
=end
- method set_finalize ($sub) {
- $!finalize := get_sub_obj($sub);
+ method finalize ($sub?) {
+ if pir::defined__IP($sub) {
+ $!finalize := get_sub_obj($sub);
+ }
+ return $!finalize;
};
=begin
-=item set_data(data)
+=item data(data) or data()
Sets the data attribute.
+Returns the current set data.
=cut
=end
- method set_data ($data) {
- $!data := $data;
+ method data ($data?) {
+ if pir::defined__IP($data) {
+ $!data := $data;
+ }
+ return $data;
};
=begin
@@ -175,7 +187,7 @@
}
if !pir::defined__IP($lookup) {
- pir::die('Could not find sub ' ~ $sub ~ ' in the namespaces.');
+ die('Could not find sub ' ~ $sub ~ ' in the namespaces.');
}
$sub := $lookup;
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -84,7 +84,9 @@
=end
method enable () {
- $!probe_obj.enable();
+ if pir::defined__IP($!probe_obj) {
+ $!probe_obj.enable();
+ }
};
=begin
@@ -96,9 +98,11 @@
=end
method disable () {
- $!probe_obj.disable();
+ if pir::defined__IP($!probe_obj) {
+ $!probe_obj.disable();
+ }
};
-
+
=begin
=item _raise_event($event, $data)
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -56,7 +56,7 @@
=end
method can_handle ($task) {
- my $subtype := pir::getattribute_p_p_s__PPS($task, "subtype");
+ my $subtype := pir::getattribute__PPS($task, "subtype");
my $list := pir::set_p_p_kc__PPS($!events, $subtype);
return pir::defined__IP($list);
@@ -100,10 +100,10 @@
=end
sub handler ($handler, $task) {
- my $subtype := pir::getattribute_p_p_s__PPS($task, "subtype");
- my $events := pir::getattribute_p_p_s__PPS($handler, '$!events');
+ my $subtype := pir::getattribute__PPS($task, "subtype");
+ my $events := pir::getattribute__PPS($handler, '$!events');
my $list := pir::set_p_p_kc__PPS($events, $subtype);
- my $data := pir::getattribute_p_p_s__PPS($task, "data");
+ my $data := pir::getattribute__PPS($task, "data");
for $list {
$_($data);
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -17,8 +17,7 @@
Example usage:
- # Create a catchall probe which will be called for
- # each op.
+ # Create an event handler to receive loadlib notifications.
evt = new ['Instrument';'Event';'Internal';'loadlib']
evt.'set_callback'('loadlib_callback')
@@ -64,7 +63,7 @@
$!probe_obj := Instrument::Probe.new();
$!probe_obj.inspect('new');
- $!probe_obj.set_callback(pir::get_global__PS('callback'));
+ $!probe_obj.callback(pir::get_global__PS('callback'));
};
sub callback ($op, $instr_obj, $probe) {
@@ -98,7 +97,7 @@
$!probe_obj.inspect('callmethod');
$!probe_obj.inspect('callmethodcc');
- $!probe_obj.set_callback(pir::get_global__PS('callback'));
+ $!probe_obj.callback(pir::get_global__PS('callback'));
};
sub callback ($op, $instr_obj) {
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp Wed Jun 23 13:01:31 2010 (r47783)
@@ -5,7 +5,7 @@
=begin
=head1 NAME
-
+
runtime/parrot/library/Instrument/Probe.nqp - Helper class to automate inserting and removing hooks from the interpreter.
=head1 SYNOPSIS
@@ -57,15 +57,19 @@
};
=begin
-=item make_catchall()
+=item catchall($catchall?)
-Set this probe to catch all ops.
+Set this probe to catch all ops if $catchall is not zero.
+Returns the current catchall status.
=cut
=end
- method make_catchall () {
- $!is_catchall := 1;
+ method catchall ($catchall?) {
+ if pir::defined__IP($catchall) {
+ $!is_catchall := $catchall;
+ }
+ return $!is_catchall
}
=begin
@@ -87,20 +91,28 @@
for $op {
self.inspect($_);
}
- } else {
+ }
+ else {
# $op is singular.
- my $type := pir::typeof__PP($op);
+ my $oplib := Q:PIR { %r = new ['OpLib'] };
+ my $type := pir::typeof__PP($op);
if $type eq 'Integer' {
# $op = op number.
- $!oplist.push($op);
- } else {
- my $oplib := Q:PIR { %r = new ['OpLib'] };
-
+ if $op > pir::set__IP($oplib) {
+ # op number is invalid.
+ # Put it in the todo list.
+ $!todo_oplist.push($op);
+ }
+ else {
+ $!oplist.push($op);
+ }
+ }
+ else {
# Lookup the op.
my $op_ret;
my $op_num;
-
+
$op_ret := $oplib.op_family($op);
if pir::defined__IP($op_ret) {
# $op = short name.
@@ -108,7 +120,8 @@
$op_num := pir::set__IP($_);
$!oplist.push($op_num);
}
- } else {
+ }
+ else {
# $op = long name.
$op_ret := pir::set_p_p_k__PPP($oplib, $op);
$op_num := pir::set__IP($op_ret);
@@ -144,7 +157,7 @@
}
# Check for any todo_oplist.
- if pir::set_i_p__IP($!todo_oplist) != 0 {
+ if pir::set__IP($!todo_oplist) != 0 {
# Double check the todo_oplist.
my $list := $!todo_oplist;
$!todo_oplist := Q:PIR { %r = new ['ResizablePMCArray'] };
@@ -154,13 +167,13 @@
# If there is still a todo_oplist,
# set up an event handler to update.
- if pir::set_i_p__IP($!todo_oplist) != 0 {
+ if pir::set__IP($!todo_oplist) != 0 {
$Instrument::Probe::loadlib_probelist.push(self);
if !pir::defined__IP($Instrument::Probe::loadlib_evt) {
$Instrument::Probe::loadlib_evt := Instrument::Event::Internal::loadlib.new();
- $Instrument::Probe::loadlib_evt.set_callback(pir::get_global__PS('loadlib_callback'));
- $Instrument::Probe::loadlib_evt.set_data(self);
+ $Instrument::Probe::loadlib_evt.callback(pir::get_global__PS('loadlib_callback'));
+ $Instrument::Probe::loadlib_evt.data(self);
$!instr_obj.attach($Instrument::Probe::loadlib_evt);
}
}
@@ -194,7 +207,7 @@
=cut
=end
-
+
method disable () {
if !pir::defined__IP($!instr_obj) {
pir::die('Probe has not been attached to an Instrument object.');
@@ -215,6 +228,30 @@
}
};
+=begin
+=item get_op_list()
+
+Returns the list of op numbers inspected by this probe.
+
+=cut
+=end
+
+ method get_op_list () {
+ return $!oplist;
+ }
+
+=begin
+=item get_op_todo_list()
+
+Returns the list of items passed to inspect
+
+=cut
+=end
+
+ method get_op_todo_list () {
+ return $!todo_oplist;
+ }
+
# Internal helper: Callback for loadlib events registered when the probe has
# any outstanding ops in $!todo_oplist.
sub loadlib_callback ($data) {
Modified: branches/gsoc_instrument/src/dynpmc/instrument.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrument.pmc Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/src/dynpmc/instrument.pmc Wed Jun 23 13:01:31 2010 (r47783)
@@ -245,6 +245,7 @@
int argc = 0, status;
char * default_argv[] = {NULL};
char ** argv = default_argv;
+ char * file_c;
Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
PMC *probe_iter;
int counter = 0;
@@ -275,14 +276,16 @@
normalise_vtables(INTERP, attr->supervised);
/* Begin Execution */
+ file_c = Parrot_str_to_cstring(attr->supervised, file);
status = imcc_run(attr->supervised,
- Parrot_str_cstring(attr->supervised, file),
+ file_c,
argc, (const char **) argv);
if (status) {
imcc_run_pbc(attr->supervised,
attr->supervised->output_file,
argc, (const char **) argv);
}
+ Parrot_str_free_cstring(file_c);
/* Finalize the instruments */
probe_iter = VTABLE_get_iter(INTERP, attr->probes);
Modified: branches/gsoc_instrument/t/dynpmc/instrumentop.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrumentop.t Wed Jun 23 08:43:03 2010 (r47782)
+++ branches/gsoc_instrument/t/dynpmc/instrumentop.t Wed Jun 23 13:01:31 2010 (r47783)
@@ -1,6 +1,6 @@
#!./parrot
# Copyright (C) 2010, Parrot Foundation.
-# $Id: instrument.t 47641 2010-06-15 16:38:51Z khairul $
+# $Id$
=head1 NAME
@@ -72,7 +72,7 @@
probe_class = get_hll_global ['Instrument'], 'Probe'
probe = probe_class.'new'()
probe.'inspect'('say_sc')
- probe.'set_callback'('test_one_op_callback')
+ probe.'callback'('test_one_op_callback')
# Create the Instrument instance and run it
# against t/dynpmc/instrumentop-test1.pir.
Added: branches/gsoc_instrument/t/library/instrument_probe.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_instrument/t/library/instrument_probe.t Wed Jun 23 13:01:31 2010 (r47783)
@@ -0,0 +1,353 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/library/instrument_probe.t - test Instrument::Probe.
+
+=head1 SYNOPSIS
+
+ % prove t/library/instrument_probe.t
+
+=head1 DESCRIPTION
+
+Tests the Instrument::Probe helper class.
+
+=cut
+
+.include 'except_severity.pasm'
+.include 'except_types.pasm'
+.loadlib 'os'
+
+.sub main :main
+ .include 'test_more.pir'
+
+ # Load the Instrument library.
+ load_bytecode 'Instrument/InstrumentLib.pbc'
+
+ plan(17)
+
+ setup()
+ test_core_op()
+ test_dyn_op()
+ test_op_family()
+ test_callback()
+ test_finalize()
+ test_enable()
+ test_disable()
+ cleanup()
+
+ .return()
+.end
+
+.sub setup
+ .local string program
+ .local pmc fh
+
+ ##
+ # Dynop test file.
+ ##
+ program = <<'PROG'
+.loadlib 'io_ops'
+.sub main :main
+ $S1 = 't/library/instrument_probe-dynop.pir'
+ $P0 = open $S1, 'r'
+ $S0 = read $P0, 1024
+ close $P0
+.end
+PROG
+
+ fh = new ['FileHandle']
+ fh.'open'('t/library/instrument_probe-dynop.pir', 'w')
+ fh.'puts'(program)
+ fh.'close'()
+
+ ##
+ # Simple 2 op test file.
+ ##
+ program = <<'PROG'
+.sub main :main
+ say "2 Op test"
+ end
+.end
+PROG
+
+ fh = new ['FileHandle']
+ fh.'open'('t/library/instrument_probe-2-op.pir', 'w')
+ fh.'puts'(program)
+ fh.'close'()
+.end
+
+.sub cleanup
+ # Remove the op test program.
+ .local pmc os
+ os = new ['OS']
+ os.'rm'('t/library/instrument_probe-dynop.pir')
+ os.'rm'('t/library/instrument_probe-2-op.pir')
+.end
+
+.sub test_core_op
+ .local pmc probe, probe_class, oplib
+ oplib = new ['OpLib']
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+ probe.'inspect'('say_sc')
+
+ # Since say_sc is a single op and not a family of ops,
+ # the op list should only have one entry.
+ # Op number must also correspond to that from OpLib.
+
+ # Check op count.
+ $P0 = probe.'get_op_list'()
+ $I0 = $P0
+ is($I0, 1, 'Core op: One entry in op list.')
+
+ # Check todo count.
+ $P0 = probe.'get_op_todo_list'()
+ $I0 = $P0
+ is($I0, 0, 'Core op: No entry in todo list.')
+
+ # Check opcode number
+ $P0 = probe.'get_op_list'()
+ $P1 = oplib['say_sc']
+ $I1 = $P1
+ $I0 = $P0[0]
+ is($I0, $I1, 'Core op: Op number matches that of OpLib')
+.end
+
+.sub test_dyn_op
+ .local pmc probe, probe_class, oplib, opcode, instr, args
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_probe-dynop.pir'
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+ probe.'inspect'('read_s_p_ic')
+
+ # At this point, the dynop does not exist.
+
+ # Check op count.
+ $P0 = probe.'get_op_list'()
+ $I0 = $P0
+ is($I0, 0, 'Dyn op: (Before) No entry in op list.')
+
+ # Check todo count.
+ $P0 = probe.'get_op_todo_list'()
+ $I0 = $P0
+ is($I0, 1, 'Dyn op: (Before) One entry in todo list.')
+
+ # Attach it to the instrument, run the dynop test file.
+ # Then recheck the counts.
+ instr = new ['Instrument']
+ instr.'attach'(probe)
+ instr.'run'('t/library/instrument_probe-dynop.pir', args)
+
+ # Check op count.
+ $P0 = probe.'get_op_list'()
+ $I0 = $P0
+ is($I0, 1, 'Dyn op: (After) One entry in op list.')
+
+ # Check todo count.
+ $P0 = probe.'get_op_todo_list'()
+ $I0 = $P0
+ is($I0, 0, 'Dyn op: (After) No entry in todo list.')
+.end
+
+.sub test_op_family
+ .local pmc probe, probe_class, oplib
+ oplib = new ['OpLib']
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+ probe.'inspect'('set')
+
+ # The set family of opcodes has 29 ops.
+ # Ensure that all the ops in this set have the family
+ # name of set.
+ $I0 = 1
+ $P1 = oplib.'op_family'('set')
+ $P0 = probe.'get_op_list'()
+ $I1 = $P0
+ $I2 = $P1
+ is($I1, $I2, 'Op Family: The op counts match')
+
+ $P2 = iter $P0
+ BEGIN:
+ unless $P2 goto END
+ $I1 = shift $P2
+ $P3 = oplib[$I1]
+ $S0 = $P3.'family_name'()
+
+ if $S0 == 'set' goto BEGIN
+ $I0 = 0
+ END:
+ is($I0, 1, 'Op Family: Ops in oplist belong to the "set" family.')
+.end
+
+.sub test_callback
+ .local pmc probe, probe_class, oplib, opcode, instr, args, eh
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_probe-2-op.pir'
+
+ # Exception handler to catch exit.
+ eh = new ['ExceptionHandler']
+ eh.'handle_types'(.CONTROL_ERROR, .CONTROL_EXIT)
+ eh.'min_severity'(.EXCEPT_NORMAL)
+ eh.'max_severity'(.EXCEPT_EXIT)
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+
+ # Test pass by name.
+ probe.'callback'('generic_callback')
+ $P0 = probe.'callback'()
+ $S0 = $P0
+ is($S0, 'generic_callback', 'Callback: Pass by name ok.')
+
+ # Test pass by reference.
+ $P0 = get_global 'generic_callback2'
+ probe.'callback'($P0)
+ $P1 = probe.'callback'()
+ is($P1, $P0, 'Callback: Pass by reference ok.')
+
+ # Test bad pmc type.
+ $P0 = new ['Hash']
+ set_addr eh, BAD_PMC_OK
+ push_eh eh
+ probe.'callback'($P0)
+
+ ok(0, 'Callback: Bad PMC not ok.')
+ goto BAD_PMC_END
+
+ BAD_PMC_OK:
+ ok(1, 'Callback: Bad PMC ok.')
+ BAD_PMC_END:
+
+ pop_eh
+
+ # Test non-existent sub.
+ set_addr eh, NON_EX_SUB_OK
+ push_eh eh
+ probe.'callback'('non existent sub')
+
+ ok(0, 'Callback: Non-existent sub not ok.')
+ goto NON_EX_SUB_END
+
+ NON_EX_SUB_OK:
+ ok(1, 'Callback: Non-existent sub ok.')
+ NON_EX_SUB_END:
+
+ pop_eh
+
+ # Test running. Only inspect the say op.
+ probe.'callback'('test_callback_callback')
+ probe.'inspect'('say_sc')
+
+ instr = new ['Instrument']
+ instr.'attach'(probe)
+ instr.'run'('t/library/instrument_probe-2-op.pir', args)
+.end
+
+.sub test_callback_callback
+ ok(1, 'Callback: Callback called.')
+.end
+
+.sub test_finalize
+ .local pmc probe, probe_class, oplib, opcode, instr, args, eh
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_probe-2-op.pir'
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+
+ # Since finalize shares most of the lookup code with
+ # callback, only test calling of the finalize callback.
+ probe.'finalize'('test_finalize_callback')
+
+ instr = new ['Instrument']
+ instr.'attach'(probe)
+ instr.'run'('t/library/instrument_probe-2-op.pir', args)
+.end
+
+.sub test_finalize_callback
+ ok(1, 'Finalize: Callback called.')
+.end
+
+.sub test_enable
+ .local pmc probe, probe_class, oplib, opcode, instr, args, eh
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_probe-2-op.pir'
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+
+ # We only want the callback to be called once.
+ # So set it to inspect end.
+ probe.'inspect'('end')
+ probe.'callback'('test_enable_callback')
+
+ instr = new ['Instrument']
+ instr.'attach'(probe)
+
+ # On attach, the probe is enabled.
+ # Disable and then reenable it.
+ probe.'disable'()
+ probe.'enable'()
+
+ # Run
+ instr.'run'('t/library/instrument_probe-2-op.pir', args)
+.end
+
+.sub test_enable_callback
+ ok(1, 'Enable: Enable is ok.')
+.end
+
+.sub test_disable
+ .local pmc probe, probe_class, oplib, opcode, instr, args, eh
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_probe-2-op.pir'
+
+ $P0 = box 0
+ set_global "$test_disable_fail", $P0
+
+ probe_class = get_hll_global ['Instrument'], 'Probe'
+ probe = probe_class.'new'()
+
+ # We only want the callback to be called once.
+ # So set it to inspect end.
+ probe.'inspect'('end')
+ probe.'callback'('test_disable_callback')
+
+ instr = new ['Instrument']
+ instr.'attach'(probe)
+
+ # On attach, the probe is enabled.
+ # Disable it.
+ probe.'disable'()
+
+ # Run
+ instr.'run'('t/library/instrument_probe-2-op.pir', args)
+
+ $P0 = get_global "$test_disable_fail"
+ is($P0, 0, 'Disable: Disable is ok.')
+.end
+
+.sub test_disable_callback
+ $P0 = box 1
+ set_global "$test_disable_fail", $P0
+.end
+
+# Stub callbacks.
+.sub generic_callback
+.end
+
+.sub generic_callback2
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
More information about the parrot-commits
mailing list