[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