[svn:parrot] r47806 - in branches/gsoc_instrument: . runtime/parrot/library/Instrument t/library
khairul at svn.parrot.org
khairul at svn.parrot.org
Thu Jun 24 12:16:48 UTC 2010
Author: khairul
Date: Thu Jun 24 12:16:47 2010
New Revision: 47806
URL: https://trac.parrot.org/parrot/changeset/47806
Log:
Added test for loadlib event.
Added:
branches/gsoc_instrument/t/library/instrument_eventlibrary.t (contents, props changed)
Modified:
branches/gsoc_instrument/MANIFEST
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
Modified: branches/gsoc_instrument/MANIFEST
==============================================================================
--- branches/gsoc_instrument/MANIFEST Thu Jun 24 11:47:24 2010 (r47805)
+++ branches/gsoc_instrument/MANIFEST Thu Jun 24 12:16:47 2010 (r47806)
@@ -1713,6 +1713,7 @@
t/library/dumper.t [test]
t/library/getopt_obj.t [test]
t/library/hllmacros.t [test]
+t/library/instrument_eventlibrary.t [test]
t/library/instrument_probe.t [test]
t/library/iter.t [test]
t/library/lwp.t [test]
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Thu Jun 24 11:47:24 2010 (r47805)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Thu Jun 24 12:16:47 2010 (r47806)
@@ -50,31 +50,44 @@
Raises an event whenever a class is instantiated.
-TODO: Add inspect so that specific classes can be targetted.
+TODO: How about instantiations from C? Inspecting new opcodes
+ don't really help that. Redo. Hold off until InstrumentPMC is done.
=cut
=end
class Instrument::Event::Class::instantiate is Instrument::Event {
-
method _self_init() {
$!event_type := 'Instrument::Event::Class::instantiate';
+ my $class_hash := Q:PIR { %r = new ['Hash'] };
+ self.data($class_hash);
+
$!probe_obj := Instrument::Probe.new();
+ $!probe_obj.data(self);
$!probe_obj.inspect('new');
$!probe_obj.callback(pir::get_global__PS('callback'));
};
+ method inspect ($class) {
+ pir::set_p_k_ic($!class_hash, $class, 1);
+ };
+
sub callback ($op, $instr_obj, $probe) {
my $class := $op.get_arg(1);
- my $data := Q:PIR { %r = new ['ResizablePMCArray'] };
- $data.push($class);
- $data.push($op);
- $data.push($instr_obj);
+ # Check if class is to be inspected.
+ my $data := $probe.data().data();
+ if pir::set__IP($data) == 0
+ || pir::exists_i_p_k__IPP($data, $class) {
+ my $data := Q:PIR { %r = new ['ResizablePMCArray'] };
+ $data.push($class);
+ $data.push($op);
+ $data.push($instr_obj);
- Instrument::Event::_raise_event('Instrument::Event::Class::instantiate', $data);
+ Instrument::Event::_raise_event('Instrument::Event::Class::instantiate', $data);
+ }
};
};
@@ -83,7 +96,7 @@
Raises an event whenever a class method is called.
-TODO: Add inspect so that specific methods and classes can be targetted.
+TODO: Similarly, how about calling from C? Hold off until InstrumentPMC is done.
=cut
=end
Added: branches/gsoc_instrument/t/library/instrument_eventlibrary.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_instrument/t/library/instrument_eventlibrary.t Thu Jun 24 12:16:47 2010 (r47806)
@@ -0,0 +1,125 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id $
+
+=head1 NAME
+
+t/library/instrument_eventlibrary.t - test the classes in Instrument/EventLibrary.nqp.
+
+=head1 SYNOPSIS
+
+ % prove t/library/instrument_eventlibrary.t
+
+=head1 DESCRIPTION
+
+Tests the various provided event classes in Instrument/EventLibrary.nqp.
+
+=head1 TODO
+
+Class::* is not complete. Holding off until InstrumentPMC is done.
+
+=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(0)
+
+ test_loadlib()
+
+ .return()
+.end
+
+.sub test_loadlib
+ .local pmc fh, os, event, instr, args
+ .local string program1, program2
+
+ # Dynlib loading has 4 scenarios.
+ # 1. .loadlib directive
+ # 2. loadlib opcode
+ # 3. load_bytecode which then has a loadlib directive
+ # 4. load_bytecode a file which has a :load sub that executes a loadlib opcode.
+
+ ##
+ # PIR program files to test loadlib.
+ ##
+ program1 = <<'PROG1'
+.loadlib 'io_ops'
+.sub main :main
+ $P0 = loadlib 'os'
+ load_bytecode 't/library/instrument_eventlibrary-loadlib-2.pir'
+.end
+PROG1
+
+ fh = new ['FileHandle']
+ fh.'open'('t/library/instrument_eventlibrary-loadlib-1.pir', 'w')
+ fh.'puts'(program1)
+ fh.'close'()
+
+ program2 = <<'PROG2'
+.loadlib 'bit_ops'
+.sub '' :init :load :anon
+ $P0 = loadlib 'file'
+.end
+PROG2
+
+ fh = new ['FileHandle']
+ fh.'open'('t/library/instrument_eventlibrary-loadlib-2.pir', 'w')
+ fh.'puts'(program2)
+ fh.'close'()
+
+ # Run the test.
+ $P0 = new ['Hash']
+ set_global '%test_loadlib_res', $P0
+ args = new ['ResizableStringArray']
+ push args, 't/library/instrument_eventlibrary-loadlib-2.pir'
+
+ $P1 = get_hll_global ['Instrument';'Event';'Internal'], 'loadlib'
+ event = $P1.'new'()
+ event.'callback'('test_loadlib_callback')
+
+ instr = new ['Instrument']
+ instr.'attach'(event)
+ instr.'run'('t/library/instrument_eventlibrary-loadlib-1.pir', args)
+
+ # Check the result.
+ $P0 = get_global '%test_loadlib_res'
+ $I0 = $P0['io_ops']
+ is($I0, 1, 'Loadlib: Scenario 1 ok.')
+
+ $I0 = $P0['os']
+ is($I0, 1, 'Loadlib: Scenario 2 ok.')
+
+ $I0 = $P0['bit_ops']
+ is($I0, 1, 'Loadlib: Scenario 3 ok.')
+
+ $I0 = $P0['file']
+ is($I0, 1, 'Loadlib: Scenario 4 ok.')
+
+ # Cleanup.
+ os = new ['OS']
+ os.'rm'('t/library/instrument_eventlibrary-loadlib-1.pir')
+ os.'rm'('t/library/instrument_eventlibrary-loadlib-2.pir')
+.end
+
+.sub test_loadlib_callback
+ .param pmc data
+
+ # data[0] is the library name.
+ $P0 = get_global '%test_loadlib_res'
+ $S0 = data[0]
+ $P0[$S0] = 1
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
More information about the parrot-commits
mailing list