#!/usr/bin/env perl use strict; use warnings; no warnings 'redefine'; no warnings 'once'; use Test::More; use File::Spec; use File::Basename; use rlib '../lib'; note( "Testing Devel::CmdProcessor::Command::Complete" ); BEGIN { use_ok( 'Devel::Trepan::CmdProcessor::Command::Complete' ); } require_ok( 'Devel::Trepan::CmdProcessor' ); # Monkey::Patch doesn't work with methods with prototypes; my $counter = 1; sub monkey_patch_instance { my($instance, $method, $code) = @_; my $package = ref($instance) . '::MonkeyPatch' . $counter++; no strict 'refs'; @{$package . '::ISA'} = (ref($instance)); *{$package . '::' . $method} = $code; bless $_[0], $package; # sneaky re-bless of aliased argument } my @msgs = (); my $dir = File::Spec->catfile(dirname(__FILE__), '..', 'lib', 'Devel', 'Trepan', 'CmdProcessor', 'Command'); my $cmdproc_opts = {cmddir => [$dir]}; my $cmdproc = Devel::Trepan::CmdProcessor->new(undef, undef, $cmdproc_opts); monkey_patch_instance($cmdproc, msg => sub { my($self, $message, $opts) = @_; push @msgs, $message; }); my $cmd = Devel::Trepan::CmdProcessor::Command::Complete->new($cmdproc); my $prefix = 'disas'; $cmd->{proc}{cmd_argstr} = $prefix; @msgs = (); $cmd->run([$cmd->name, $prefix]); is($msgs[0], 'disassemble'); done_testing();